+- HP Forums (https://www.hpmuseum.org/forum)
+-- Forum: HP Software Libraries (/forum-10.html)
+--- Forum: HP Prime Software Library (/forum-15.html)
+--- Thread: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose .. (/thread-40.html)
Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose .. - patrice - 12-12-2013 05:46 AM
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;Nota 2014/08/26 : Last version in post #7
RE: Fractals using Lindenmayer System - ArielPalazzesi - 12-13-2013 04:32 PM
Thanks!
Lindenmayer System is one of the best fractal family.
RE: Fractals using Lindenmayer System - eried - 12-13-2013 05:41 PM
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
RE: Fractals using Lindenmayer System - patrice - 12-13-2013 06:09 PM
Quote:I am getting "?HMS"the right-arrow appear correctly in the post.
Quote:I think it is better if you upload a .txt fileI 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.
RE: Fractals using Lindenmayer System - eried - 12-13-2013 06:44 PM
:/ I see, maybe it is chrome, because I am pasting directly to the conn kit, and everything is messed up
RE: Fractals using Lindenmayer System - Han - 12-13-2013 07:32 PM
(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.
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose .. - patrice - 08-26-2014 04:49 PM
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[1]:= CONCAT(LPoints[1], Xp); LPoints[2]:= CONCAT(LPoints[2], Yp); LLines:= CONCAT(LLines,{{LineT,SIZE(LPoints[1]),#0}}); LineT:= SIZE(LPoints[1]); 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])-1; Xmax := MAX(LPoints[1])+1;
Ymin := MIN(LPoints[2])-1; Ymax := MAX(LPoints[2])+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[1]:= 320/(Xmax-Xmin)*(LPoints[1]-Xmin);
LPoints[2]:= 240/(Ymax-Ymin)*(Ymax-LPoints[2]);
LPoints;
Tmp:= {}; // transposition liste de listes
FOR Xp FROM 1 TO SIZE(LPoints[1]) 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:= "[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 == 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;RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose .. - compsystems - 08-27-2014 01:52 AM
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;RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski... - Joe Horn - 08-27-2014 05:23 AM
(08-26-2014 04:49 PM)patrice Wrote: New version taking advantage of rev 6030
Now with 28 Lindenmayer System fractals
Sweet! Thanks, Patrice!
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose .. - patrice - 08-27-2014 07:15 AM
(08-27-2014 01:52 AM)compsystems Wrote: Hi, sorry google translator, do you have some code a similar in Q-BASIC?You should start at 1, not 0.
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;
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.
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose .. - patrice - 08-27-2014 07:20 AM
(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
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose .. - patrice - 08-27-2014 03:41 PM
(08-27-2014 02:10 PM)compsystems Wrote: { "1:...", "2:...", ... } choose not work, when I press the number keys on my emulatorWhere 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.
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose .. - Richard Wagner - 09-05-2014 04:11 PM
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.
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose .. - patrice - 09-07-2014 07:47 AM
Hi Richard,
(09-05-2014 04:11 PM)Richard Wagner Wrote: Beautifully done! Excellent accomplishment!It is always a pleasure to see that some work is appreciated.
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.
Thanks for your support.
RE: Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose .. - StephenG1CMZ - 09-19-2015 11:56 AM
(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 emulatorWhere 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.