Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose ..
12-12-2013, 05:46 AM (This post was last modified: 09-05-2014 04:16 PM by patrice.)
Post: #1 patrice Member Posts: 180 Joined: Dec 2013
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:= "++++++++";     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
12-13-2013, 04:32 PM
Post: #2
 ArielPalazzesi Member Posts: 90 Joined: Dec 2013
RE: Fractals using Lindenmayer System
Thanks!
Lindenmayer System is one of the best fractal family.
12-13-2013, 05:41 PM
Post: #3 eried Senior Member Posts: 741 Joined: Dec 2013
RE: Fractals using Lindenmayer System
Does the code copies correctly from the code tags in this forum?

I am getting "?HMS", I think it is better if you upload a .txt file

My website: erwin.ried.cl
12-13-2013, 06:09 PM (This post was last modified: 12-13-2013 08:11 PM by patrice.)
Post: #4 patrice Member Posts: 180 Joined: Dec 2013
RE: Fractals using Lindenmayer System
Quote:I am getting "?HMS"
the right-arrow appear correctly in the post.
Quote:I think it is better if you upload a .txt file
I guess text file or not will be sorted out when every one will be used to the new forum.
I just tested copying code and every thing is fine for me.
I pasted to emulator with no problem and to a text editor too, I just made sure the text editor use unicode before pasting.

Patrice
“Everything should be made as simple as possible, but no simpler.” Albert Einstein
12-13-2013, 06:44 PM
Post: #5 eried Senior Member Posts: 741 Joined: Dec 2013
RE: Fractals using Lindenmayer System
:/ I see, maybe it is chrome, because I am pasting directly to the conn kit, and everything is messed up

My website: erwin.ried.cl
12-13-2013, 07:32 PM
Post: #6 Han Senior Member Posts: 1,812 Joined: Dec 2013
RE: Fractals using Lindenmayer System
(12-13-2013 06:44 PM)eried Wrote:  :/ I see, maybe it is chrome, because I am pasting directly to the conn kit, and everything is messed up

Chrome preferences (Advanced settings) will allow you to change the font encoding. This is likely the issue you are having.

Graph 3D | QPI | SolveSys
08-26-2014, 04:49 PM (This post was last modified: 08-26-2014 04:55 PM by patrice.)
Post: #7 patrice Member Posts: 180 Joined: Dec 2013
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose ..
New version taking advantage of rev 6030
Now with 28 Lindenmayer System fractals
Use key A to change Aspect ratio on screen
Faster drawing
Press Help for explanations
Code:
 #pragma mode( separator(.,;) integer(h64) ) // Fractal : Lindenmayer system // V 1.5 02/2013 // V 2.0 08/2014 taking advantage of Rev 6030 //    and more fractals //    simplify and speedup EXPORT LSangle, LSdir, LSaxiom, LSaxiomOrg, LSgen, LSrules, LSNum; Stk, Clr, Aspect, LPoints, LLines, Timing; //EXPORT Xmin, Xmax, YMin, YMax; // Stack functions 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 // Color for a segment   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; LSdraw(Axiom) BEGIN   LOCAL Scan, Code, LineT, Xp, Yp, Ap, Tmp;   IF SIZE(LPoints) == 0 THEN     StkInit(); Xp:= 0; Yp:= 0; Ap:= LSdir;     Xmin:= 0; Xmax:= 0; Ymin:= 0; Ymax:= 0;     LPoints:= {{0},{0}}; LLines:= {}; LineT:= 1;     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);         IF Code = "F" THEN LPoints:= CONCAT(LPoints, Xp); LPoints:= CONCAT(LPoints, Yp); LLines:= CONCAT(LLines,{{LineT,SIZE(LPoints),#0}}); LineT:= SIZE(LPoints); END;       END;       IF Code = "-" THEN Ap:= Ap- LSangle; END;       IF Code = "+" THEN Ap:= Ap+ LSangle; END;       IF Code = "|" THEN Ap:= Ap+ 180; END;       IF Code = "[" THEN StkPush(Xp); StkPush(Yp); StkPush(Ap); StkPush(LineT); END;       IF Code = "]" THEN LineT:= StkPop(); Ap:= StkPop(); Yp:= StkPop(); Xp:= StkPop(); END;     END;     IF SIZE(LPoints) > 1 THEN         // échelle       Xmin := MIN(LPoints)-1; Xmax := MAX(LPoints)+1;       Ymin := MIN(LPoints)-1; Ymax := MAX(LPoints)+1;       CASE         IF Aspect == 0 THEN END;         IF (Xmax- Xmin)*3 < (Ymax- Ymin)*4 THEN Tmp:= ((Ymax- Ymin)*4/3 - (Xmax- Xmin))/2; Xmin:= Xmin-Tmp; Xmax:= Xmax+Tmp; END;         IF (Xmax- Xmin)*3 > (Ymax- Ymin)*4 THEN Tmp:= ((Xmax- Xmin)*3/4 - (Ymax- Ymin))/2; Ymin:= Ymin-Tmp; Ymax:= Ymax+Tmp; END;       END;       IF Clr == 1 THEN // couleur         FOR Xp FROM 1 TO SIZE(LLines) DO           LLines[Xp,3]:= LSclr(Xp/SIZE(LLines));         END;       END;       LPoints:= 320/(Xmax-Xmin)*(LPoints-Xmin);       LPoints:= 240/(Ymax-Ymin)*(Ymax-LPoints);       LPoints;       Tmp:= {}; // transposition liste de listes       FOR Xp FROM 1 TO SIZE(LPoints) DO         Tmp:= CONCAT(Tmp,{{LPoints[1,Xp],LPoints[2,Xp]}});       END;       LPoints:= Tmp;     END;   END;   RECT();   IF SIZE(LPoints) > 1 THEN     LINE_P(LPoints,LLines,[[1,0],[0,1]]);   END;   RETURN; END; LSnext(Axiom) BEGIN // Calc next generation   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;   LPoints:= {};   Timing:= (Ticks-Timing) /3600000;   RETURN Rep; END; LSinit(Nr) BEGIN // init a new fractal root   IF Nr == 0 THEN // Choose     RETURN {"Hilbert curve", "Hilbert curve II", "Moore Curve", "Penrose Tiling", "Harter-Heighway dragon", "Terdragon", "Mandelbrot H Tree", "Sierpinski curve", "Sierpinski arrowhead curve", "Sierpinski Sieve", "Sierpinski carpet", "Peano-Gosper curve", "Quadratic Gosper curve", "Peano curve", "Koch SnowFlake", "Quadratic Koch island", "Koch curve", "Quadratic Koch curve", "Koch antisnowflake", "Minkowski sausage", "Cross-stitch curve", "Anticross-stitch curve", "Penta Plexity", "McWorter's Pentigree", "Pentadentrite", "Kristall", "Plant 1", "Plant 2"};   END;   IF Nr == 1 THEN // Hilbert curve     LSangle:= 360/4;     LSdir:= 90;     LSaxiom:= "A";     LSrules:= {{"A", "-BF+AFA+FB-"}, {"B", "+AF-BFB-FA+"}};   END;   IF Nr == 2 THEN // Hilbert curve II     LSangle:= 360/4;     LSdir:= 90;     LSaxiom:= "X";     LSrules:= {{"X", "XFYFX+F+YFXFY-F-XFYFX"}, {"Y", "YFXFY-F-XFYFX+F+YFXFY"}};   END;   IF Nr == 3 THEN // Moore Curve     LSangle:= 360/4;     LSdir:= 0;     LSaxiom:= "LFL+F+LFL";     LSrules:= {{"L", "-RF+LFL+FR-"}, {"R", "+LF-RFR-FL+"}};   END;   IF Nr == 4 THEN // Penrose Tiling     LSangle:= 360/10;     LSdir:= 0;     LSaxiom:= "++++++++";     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 == 5 THEN // Harter-Heighway dragon     LSangle:= 360/4;     LSdir:= 90;     LSaxiom:= "FX";     LSrules:= {{"X", "X+YF+"}, {"Y", "-FX-Y"}, {"F", ""}};   END;   IF Nr == 6 THEN // Terdragon     LSangle:= 360/3;     LSdir:= 90;     LSaxiom:= "F";     LSrules:= {{"F", "F+F-F"}};   END;   IF Nr == 7 THEN // Mandelbrot H Tree     LSangle:= 360/4;     LSdir:= 0;     LSaxiom:= "A";     LSrules:= {{"A", "[-BFA]+BFA"}, {"B","C"},{"C","BFB"}};   END;   IF Nr == 8 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 == 9 THEN // Sierpinski Triangle     LSangle:= 360/6;     LSdir:= -90;     LSaxiom:= "AF";     LSrules:= {{"A", "BF-AF-B"}, {"B","AF+BF+A"}};   END;   IF Nr == 10 THEN // Sierpinski Sieve     LSangle:= 360/6;     LSdir:= -90;     LSaxiom:= "FXF++FF++FF";     LSrules:= {{"F", "FF"}, {"X","++FXF--FXF--FXF++"}};   END;   IF Nr == 11 THEN // Sierpinski carpet     LSangle:= 360/4;     LSdir:= -45;     LSaxiom:= "F";     LSrules:= {{"F", "F+F-F-FF-F-F-GF"}, {"G","GGG"}};   END;   IF Nr == 12 THEN // Peano-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 == 13 THEN // Quadratic Gosper curve     LSangle:= 360/4;     LSdir:= -90;     LSaxiom:= "-YF";     LSrules:= {{"X", "XFX-YF-YF+FX+FX-YF-YFFX+YF+FXFXYF-FX+YF+FXFX+YF-FXYF-YF-FX+FX+YFYF-"}, {"Y","+FXFX-YF-YF+FX+FXYF+FX-YFYF-FX-YF+FXYFYF-FX-YFFX+FX+YF-YF-FX+FX+YFY"}};   END;   IF Nr == 14 THEN // Peano curve     LSangle:= 360/4;     LSdir:= 45;     LSaxiom:= "F";     LSrules:= {{"F", "F+F-F-F-F+F+F+F-F"}};   END;   IF Nr == 15 THEN // Koch SnowFlake     LSangle:= 360/6;     LSdir:= 90;     LSaxiom:= "F--F--F";     LSrules:= {{"F", "F+F--F+F"}};   END;   IF Nr == 16 THEN // Quadratic Koch island     LSangle:= 360/4;     LSdir:= 0;     LSaxiom:= "F+F+F+F";     LSrules:= {{"F", "F+F-F-FF+F+F-F"}};   END;   IF Nr == 17 THEN // Koch curve     LSangle:= 360/6;     LSdir:= -90;     LSaxiom:= "F";     LSrules:= {{"F", "F+F--F+F"}};   END;   IF Nr == 18 THEN // Quadratic Koch curve     LSangle:= 360/4;     LSdir:= -90;     LSaxiom:= "F";     LSrules:= {{"F", "F+F-F-F+F"}};   END;   IF Nr == 19 THEN // Koch antisnowflake     LSangle:= 360/6;     LSdir:= 90;     LSaxiom:= "F++F++F";     LSrules:= {{"F", "F+F--F+F"}};   END;   IF Nr == 20 THEN // Minkowski sausage     LSangle:= 360/4;     LSdir:= -90;     LSaxiom:= "F";     LSrules:= {{"F", "F+F-F-FF+F+F-F"}};   END;   IF Nr == 21 THEN // Cross-stitch curve     LSangle:= 360/4;     LSdir:= 90;     LSaxiom:= "F+F+F+F";     LSrules:= {{"F", "F-F+F+F-F"}};   END;   IF Nr == 22 THEN // Anticross-stitch curve     LSangle:= 360/4;     LSdir:= 90;     LSaxiom:= "F-F-F-F";     LSrules:= {{"F", "F-F+F+F-F"}};   END;   IF Nr == 23 THEN // Penta Plexity     LSangle:= 360/10;     LSdir:= -90;     LSaxiom:= "F++F++F++F++F";     LSrules:= {{"F", "F++F++F|F-F++F"}};   END;   IF Nr == 24 THEN // McWorter's Pentigree     LSangle:= 360/10;     LSdir:= 90;     LSaxiom:= "F";     LSrules:= {{"F", "+F++F----F--F++F++F-"}};   END;   IF Nr == 25 THEN // Pentadentrite     LSangle:= 360/5;     LSdir:= 90;     LSaxiom:= "F";     LSrules:= {{"F", "F+F-F--F+F+F"}};   END;   IF Nr == 26 THEN // Kristall     LSangle:= 360/4;     LSdir:= -90;     LSaxiom:= "F";     LSrules:= {{"F", "F+F--G+F-F++G-F"}, {"G","GGG"}};   END;   IF Nr == 27 THEN // Plant 1     LSangle:= 360/16;     LSdir:= 90;     LSaxiom:= "F";     LSrules:= {{"F", "FF-[-F+F+F]+[+F-F-F]"}};   END;   IF Nr == 28 THEN // Plant 2     LSangle:= 360/18;     LSdir:= 90;     LSaxiom:= "F";     LSrules:= {{"F", "F[+F]F[-F][F]"}};   END;   LSaxiomOrg:= LSaxiom; LSgen:= 0;   LPoints:= {}; 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(STRING(Xmin)+" "+STRING(Xmax)+" "+STRING(Ymin)+" "+STRING(Ymax),10,20);   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("A: Aspect ratio/Full Screen");   PRINT("C: Color/Black");   PRINT("+: Next generation"); END; EXPORT LSystem() BEGIN   LOCAL Kb, View, Tmp;   HAngle:=1; View:= 0; Clr:= 1; Aspect:=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 == 14 THEN Aspect:= 1- Aspect; LPoints:= {}; END;     IF Kb == 16 THEN Clr:= 1- Clr; LPoints:= {}; END;     IF Kb == 50 THEN LSaxiom:= LSnext(LSaxiom); LSgen:= LSgen+ 1; END;   UNTIL Kb==4;   LSaxiom:= ""; LPoints:= {}; LLines:= {}; END;

Patrice
“Everything should be made as simple as possible, but no simpler.” Albert Einstein
08-27-2014, 01:52 AM (This post was last modified: 08-27-2014 01:59 AM by compsystems.)
Post: #8 compsystems Senior Member Posts: 1,225 Joined: Dec 2013
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose ..
Hi, sorry google translator, do you have some code a similar in Q-BASIC?

http://jm00092.freehostia.com/progqb/fractales.htm

To better identify the types of fractals add a numeration to Choose

Code:
LSinit(Nr) BEGIN // init a new fractal root   IF Nr == 0 THEN // Choose     RETURN {"0: Hilbert curve", "1: Hilbert curve II", "2: Moore Curve", "3: Penrose Tiling", "4: Harter-Heighway dragon", "5: Terdragon", "6: Mandelbrot H Tree", "7: Sierpinski curve", "8: Sierpinski arrowhead curve",          "9: Sierpinski Sieve", "10: Sierpinski carpet", "11: Peano-Gosper curve", "12: Quadratic Gosper curve", "13: Peano curve", "14: Koch SnowFlake", "15: Quadratic Koch island", "16: Koch curve", "17: Quadratic Koch curve", "18: Koch antisnowflake",         "19: Minkowski sausage", "20: Cross-stitch curve", "21: Anticross-stitch curve", "22: Penta Plexity", "23: McWorter's Pentigree", "24: Pentadentrite", "25: Kristall", "26: Plant 1", "27: Plant 2"};   END;
08-27-2014, 05:23 AM
Post: #9 Joe Horn Senior Member Posts: 1,611 Joined: Dec 2013
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski...
(08-26-2014 04:49 PM)patrice Wrote:  New version taking advantage of rev 6030
Now with 28 Lindenmayer System fractals

Sweet! Thanks, Patrice!

<0|ɸ|0>
-Joe-
08-27-2014, 07:15 AM
Post: #10 patrice Member Posts: 180 Joined: Dec 2013
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose ..
(08-27-2014 01:52 AM)compsystems Wrote:  Hi, sorry google translator, do you have some code a similar in Q-BASIC?

http://jm00092.freehostia.com/progqb/fractales.htm

To better identify the types of fractals add a numeration to Choose

Code:
LSinit(Nr) BEGIN // init a new fractal root   IF Nr == 0 THEN // Choose     RETURN {"0: Hilbert curve", "1: Hilbert curve II", "2: Moore Curve", "3: Penrose Tiling", "4: Harter-Heighway dragon", "5: Terdragon", "6: Mandelbrot H Tree", "7: Sierpinski curve", "8: Sierpinski arrowhead curve",          "9: Sierpinski Sieve", "10: Sierpinski carpet", "11: Peano-Gosper curve", "12: Quadratic Gosper curve", "13: Peano curve", "14: Koch SnowFlake", "15: Quadratic Koch island", "16: Koch curve", "17: Quadratic Koch curve", "18: Koch antisnowflake",         "19: Minkowski sausage", "20: Cross-stitch curve", "21: Anticross-stitch curve", "22: Penta Plexity", "23: McWorter's Pentigree", "24: Pentadentrite", "25: Kristall", "26: Plant 1", "27: Plant 2"};   END;
You should start at 1, not 0.
Feel free to offer a numbered list, it is a matter of taste and colors.
Since the CHOOSE is already tracking which fractal was the last one, it is rather easy to try all of them in sequence.

I don't have code in Q-Basic but translation should be easy.

Patrice
“Everything should be made as simple as possible, but no simpler.” Albert Einstein
08-27-2014, 07:20 AM
Post: #11 patrice Member Posts: 180 Joined: Dec 2013
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose ..
(08-27-2014 05:23 AM)Joe Horn Wrote:
(08-26-2014 04:49 PM)patrice Wrote:  New version taking advantage of rev 6030
Now with 28 Lindenmayer System fractals

Sweet! Thanks, Patrice!

Thanks Joe, I have chosen a large panel of fractals with only basic grammar.
If you know about other nice fractals, feel free to try and share.
It should be even faster but I can't make LINE use my scaling value, so I deal manually and use LINE_P Patrice
“Everything should be made as simple as possible, but no simpler.” Albert Einstein
08-27-2014, 03:41 PM
Post: #12 patrice Member Posts: 180 Joined: Dec 2013
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose ..
(08-27-2014 02:10 PM)compsystems Wrote:  { "1:...", "2:...", ... } choose not work, when I press the number keys on my emulator
Where did you see that it is possible to select an option in CHOOSE using numbered keys?
As far as I know, in programs, you need to use cursor or touch screen to select an option.

Patrice
“Everything should be made as simple as possible, but no simpler.” Albert Einstein
09-05-2014, 04:11 PM
Post: #13
 Richard Wagner Junior Member Posts: 18 Joined: Aug 2014
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose ..
Beautifully done! Excellent accomplishment!
Not only does this work on Emulator, but equally well on actual HP Prime itself.

I am hoping source-code will teach me much about my new HP Prime, which I only just received a day or 2 ago :-)

I am so glad I got this!

Thank you for the effort you put into putting this together, and sharing it.
09-07-2014, 07:47 AM
Post: #14 patrice Member Posts: 180 Joined: Dec 2013
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose ..
Hi Richard,
(09-05-2014 04:11 PM)Richard Wagner Wrote:  Beautifully done! Excellent accomplishment!
Not only does this work on Emulator, but equally well on actual HP Prime itself.

I am hoping source-code will teach me much about my new HP Prime, which I only just received a day or 2 ago :-)

I am so glad I got this!

Thank you for the effort you put into putting this together, and sharing it.
It is always a pleasure to see that some work is appreciated.

Patrice
“Everything should be made as simple as possible, but no simpler.” Albert Einstein
09-19-2015, 11:56 AM
Post: #15
 StephenG1CMZ Senior Member Posts: 829 Joined: May 2015
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose ..
(08-27-2014 03:41 PM)patrice Wrote:
(08-27-2014 02:10 PM)compsystems Wrote:  { "1:...", "2:...", ... } choose not work, when I press the number keys on my emulator
Where did you see that it is possible to select an option in CHOOSE using numbered keys?
As far as I know, in programs, you need to use cursor or touch screen to select an option.

I haven't seen it documented, but CHOOSE allows you to select by tapping a number or letter, provided your choice list has less than 24 items. Above 24, the number option disappears - you can't use this to select the first 24 of a long list.
Here is a demo
Code:
 EXPORT CHOOSENUM() BEGIN   CHOOSE(C,"CHOICE",{1,"ANY","TEXT",4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24}); END;

Note that these numbers/letters are put in by CHOOSE...
The existence or absence of a number as part of your choice text is irrelevant, and might differ from the ones CHOOSE uses.

Why 24? Because beyond that the letters/numbers overlap on the keypad.

If it makes a difference, this is on the Android emulator.

Stephen Lewkowicz (G1CMZ)
 « Next Oldest | Next Newest »

User(s) browsing this thread: 1 Guest(s)