Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose ..
This program is using the Lindenmayer System to build fractals on screen
The program acts like an application.
Press Help to get instructions.
Press Plot to see actual fractal.
Press Symb to see fractal setting
and Symb again to choose a fractal
+ will calculate the next generation of the fractal.
Code:
#pragma mode( separator(.,;) integer(h64) )
// Fractale : Lindenmayer system
// V 1.5 02/2013
EXPORT LSangle, LSdir, LSaxiom, LSaxiomOrg, LSgen, LSrules, LSNum;
Xmin, Xmax, Ymin, Ymax, Timing;
Stk, Clr;
StkInit()
BEGIN
Stk:= {0};
END;
StkPush(val)
BEGIN
Stk:= CONCAT(Stk, {val});
END;
StkPop()
BEGIN
LOCAL Tmp;
Tmp:= Stk(SIZE(Stk));
Stk:= SUB(Stk,1,SIZE(Stk)-1);
RETURN Tmp;
END;
LSclr(Ndx)
BEGIN
Ndx:= ROUND(Ndx*186,0);
IF Ndx < 31 THEN RETURN RGB(0,0,Ndx*8); END;
IF Ndx < 62 THEN RETURN RGB(0,(Ndx-31)*8,31*8); END;
IF Ndx < 93 THEN RETURN RGB(0,31*8,(92-Ndx)*8); END;
IF Ndx < 124 THEN RETURN RGB((Ndx-93)*8,31*8,0); END;
IF Ndx < 155 THEN RETURN RGB(31*8,(154-Ndx)*8,0); END;
IF Ndx < 186 THEN RETURN RGB(31*8,0,(Ndx-155)*8); END;
RETURN RGB(31*8,0,31*8);
END;
LSline(x1, y1, x2, y2, ndx)
BEGIN
IF Clr == 0 THEN ndx:= 0; END;
LINE_P(320/(Xmax-Xmin)*(x1-Xmin), 240/(Ymax-Ymin)*(Ymax-y1), 320/(Xmax-Xmin)*(x2-Xmin), 240/(Ymax-Ymin)*(Ymax-y2), LSclr(ndx));
END;
LSdraw(Axiom)
BEGIN
LOCAL Scan, Code, LineC, LineT;
LOCAL Xp, Yp, Ap, Xt, Yt;
RECT();
StkInit();
Xmin:= 0; Xmax:= 0;
Ymin:= 0; Ymax:= 0;
Xp:= 0; Yp:= 0; Ap:= LSdir;
LineT:= 0;
FOR Scan FROM 1 TO dim(Axiom) DO
Code:= mid(Axiom,Scan,1);
IF Code = "F" OR Code = "G" THEN
Xp:= Xp+ sin(Ap); Yp:= Yp+ cos(Ap);
Xmin := MIN(Xmin, Xp); Xmax := MAX(Xmax, Xp);
Ymin := MIN(Ymin, Yp); Ymax := MAX(Ymax, Yp);
IF Code = "F" THEN LineT:= LineT+1; END;
END;
IF Code = "-" THEN Ap:= Ap- LSangle; END;
IF Code = "+" THEN Ap:= Ap+ LSangle; END;
IF Code = "[" THEN StkPush(Xp); StkPush(Yp); StkPush(Ap); END;
IF Code = "]" THEN Ap:= StkPop(); Yp:= StkPop(); Xp:= StkPop(); END;
END;
Xmin := Xmin-1; Xmax := Xmax+1;
Ymin := Ymin-1; Ymax := Ymax+1;
StkInit();
Xp:= 0; Yp:= 0; Ap:= LSdir;
LineC:= 0;
FOR Scan FROM 1 TO dim(Axiom) DO
Code:= mid(Axiom,Scan,1);
IF Code = "F" OR Code = "G" THEN
Xt:= Xp; Yt:= Yp;
Xp:= Xp+ sin(Ap); Yp:= Yp+ cos(Ap);
IF Code = "F" THEN
LSline(Xt, Yt, Xp, Yp, LineC/LineT);
LineC:= LineC+1;
END;
END;
IF Code = "-" THEN Ap:= Ap- LSangle; END;
IF Code = "+" THEN Ap:= Ap+ LSangle; END;
IF Code = "[" THEN StkPush(Xp); StkPush(Yp); StkPush(Ap); END;
IF Code = "]" THEN Ap:= StkPop(); Yp:= StkPop(); Xp:= StkPop(); END;
END;
END;
LSnext(Axiom)
BEGIN
LOCAL LSalpha, Scan, Pos, Rep;
Timing:=Ticks;
LSalpha:= "";
FOR Scan FROM 1 TO SIZE(LSrules) DO
LSalpha:= LSalpha+ LSrules(Scan,1);
END;
Rep:= "";
FOR Scan FROM 1 TO dim(Axiom) DO
Pos:= instring(LSalpha, mid(Axiom,Scan,1));
IF Pos THEN
Rep:= Rep+ LSrules(Pos,2);
ELSE
Rep:= Rep+ mid(Axiom,Scan,1);
END;
END;
Timing:= (Ticks-Timing) /3600000;
RETURN Rep;
END;
LSinit(Nr)
BEGIN
IF Nr == 0 THEN // Choose
RETURN {"Hilbert", "Dragon", "Koch SnowFlake", "Sierpinski Triangle", "H Tree Mandelbrot", "Gosper curve", "Sierpinski curve", "Hilbert II curve", "Penrose Tiling", "Moore Curve", "Plant"};
END;
IF Nr == 1 THEN // Hilbert
LSangle:= 360/4;
LSdir:= 90;
LSaxiom:= "A";
LSrules:= {{"A", "-BF+AFA+FB-"}, {"B", "+AF-BFB-FA+"}};
END;
IF Nr == 2 THEN // Dragon
LSangle:= 360/4;
LSdir:= 90;
LSaxiom:= "FX";
LSrules:= {{"X", "X+YF+"}, {"Y", "-FX-Y"}, {"F", ""}};
END;
IF Nr == 3 THEN // Koch SnowFlake
LSangle:= 360/6;
LSdir:= 90;
LSaxiom:= "F--F--F";
LSrules:= {{"F", "F+F--F+F"}};
END;
IF Nr == 4 THEN // Sierpinski Triangle
LSangle:= 360/6;
LSdir:= -90;
LSaxiom:= "AF";
LSrules:= {{"A", "BF-AF-B"}, {"B","AF+BF+A"}};
END;
IF Nr == 5 THEN // HTree Mandelbrot
LSangle:= 360/4;
LSdir:= 0;
LSaxiom:= "A";
LSrules:= {{"A", "[-BFA]+BFA"}, {"B","C"},{"C","BFB"}};
END;
IF Nr == 6 THEN // Gosper curve
LSangle:= 360/6;
LSdir:= 0;
LSaxiom:= "XF";
LSrules:= {{"X", "X+YF++YF-FX--FXFX-YF+"}, {"Y","-FX+YFYF++YF+FX--FX-Y"}};
END;
IF Nr == 7 THEN // Sierpinski curve
LSangle:= 360/4;
LSdir:= 0;
LSaxiom:= "F+XF+F+XF";
LSrules:= {{"X", "XF-F+F-XF+F+XF-F+F-X"}};
END;
IF Nr == 8 THEN // Hilbert II curve
LSangle:= 360/4;
LSdir:= 90;
LSaxiom:= "X";
LSrules:= {{"X", "XFYFX+F+YFXFY-F-XFYFX"}, {"Y", "YFXFY-F-XFYFX+F+YFXFY"}};
END;
IF Nr == 9 THEN // Penrose Tiling
LSangle:= 360/10;
LSdir:= 0;
LSaxiom:= "[7]++[7]++[7]++[7]++[7]";
LSrules:= {{"6", "8F++9F----7F[-8F----6F]++"}, {"7", "+8F--9F[---6F--7F]+"}, {"8", "-6F++7F[+++8F++9F]-"}, {"9", "--8F++++6F[+9F++++7F]--7F"}, {"F", ""}};
END;
IF Nr == 10 THEN // Moore Curve
LSangle:= 360/4;
LSdir:= 0;
LSaxiom:= "LFL+F+LFL";
LSrules:= {{"L", "-RF+LFL+FR-"}, {"R", "+LF-RFR-FL+"}};
END;
IF Nr == 11 THEN // Plant
LSangle:= 360/16;
LSdir:= 90;
LSaxiom:= "F";
LSrules:= {{"F", "FF-[-F+F+F]+[+F-F-F]"}};
END;
LSaxiomOrg:= LSaxiom;
LSgen:= 0;
END;
LSymb()
BEGIN
LOCAL Tmp, Scan;
RECT();
TEXTOUT_P("Fractal: Lindenmayer System",0,10,2);
TEXTOUT_P("Curve Name",0,40);
TEXTOUT_P("Angle",0,60);
TEXTOUT_P("Direction",0,80);
TEXTOUT_P("Generation",0,100);
TEXTOUT_P("Axiom",0,120);
TEXTOUT_P("Rules",0,140);
TEXTOUT_P(":",100,40);
TEXTOUT_P(":",100,60);
TEXTOUT_P(":",100,80);
TEXTOUT_P(":",100,100);
TEXTOUT_P(":",100,120);
TEXTOUT_P(":",100,140);
Tmp:= LSinit(0);
TEXTOUT_P(Tmp(LSNum),120,40);
TEXTOUT_P(STRING(LSangle),120,60);
TEXTOUT_P(STRING(LSdir),120,80);
TEXTOUT_P(STRING(LSgen),120,100);
TEXTOUT_P(STRING(→HMS(Timing)),140,100);
TEXTOUT_P(LSaxiomOrg,120,120);
FOR Scan FROM 1 TO SIZE(LSrules) DO
TEXTOUT_P(LSrules(Scan,1)+ "->"+ LSrules(Scan,2), 120,120+Scan*20);
END;
END;
LHelp()
BEGIN
PRINT();
PRINT("Fractal: Lindenmayer System");
PRINT("");
PRINT("Symb first: Fractal information");
PRINT("Symb again: Choose new fractal");
PRINT("Help: this screen");
PRINT("Plot: Plot the curve");
PRINT("C: Color/Black");
PRINT("+: Next generation");
END;
EXPORT LSystem()
BEGIN
LOCAL Kb, View, Tmp;
HAngle:=1;
View:= 0;
Clr:= 1;
Timing:=0;
LSNum:= 1;
LSinit(LSNum);
REPEAT
IF View == 0 THEN LSymb(); END;
IF View == 1 THEN LSdraw(LSaxiom); END;
IF View == 6 THEN LHelp(); END;
REPEAT
Kb:= WAIT(0);
UNTIL Kb <> -1;
IF Kb == 1 AND View == 0 THEN CHOOSE(LSNum, "Fractal", LSinit(0)); IF LSNum == 0 THEN LSNum:= 1; END; LSinit(LSNum); END;
IF Kb == 1 AND View <> 0 THEN View:= 0; END;
IF Kb == 3 THEN View:= 6; END;
IF Kb == 6 THEN View:= 1; END;
IF Kb == 16 THEN Clr:= 1- Clr; END;
IF Kb == 50 THEN LSaxiom:= LSnext(LSaxiom); LSgen:= LSgen+ 1; END;
UNTIL Kb==4;
END;
Updated with new pragma to ensure the code will compile.
Nota 2014/08/26 : Last version in post #7
Patrice
“Everything should be made as simple as possible, but no simpler.” Albert Einstein
|
Search
Member List
Calendar
Help
/
Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose ..
