HP Forums / HP Software Libraries / HP Prime Software Library v / Fractals using Lindenmayer System: Hilbert, Dragon, SnowFlake, Sierpinski, Penrose ..

Post Reply 
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 Offline
Member
 		Posts: 184
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:= "[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
Find all posts by this user
Quote this message in a reply
12-13-2013, 04:32 PM
Post: #2
ArielPalazzesi Offline
Member
 		Posts: 90
Joined: Dec 2013
RE: Fractals using Lindenmayer System
Thanks!
Lindenmayer System is one of the best fractal family.
Find all posts by this user
Quote this message in a reply
12-13-2013, 05:41 PM
Post: #3
eried Offline
Senior Member
 		Posts: 746
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: ried.cl
Visit this user's website Find all posts by this user
Quote this message in a reply
12-13-2013, 06:09 PM (This post was last modified: 12-13-2013 08:11 PM by patrice.)
Post: #4
patrice Offline
Member
 		Posts: 184
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
Find all posts by this user
Quote this message in a reply
12-13-2013, 06:44 PM
Post: #5
eried Offline
Senior Member
 		Posts: 746
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: ried.cl
Visit this user's website Find all posts by this user
Quote this message in a reply
12-13-2013, 07:32 PM
Post: #6
Han Offline
Senior Member
 		Posts: 1,882
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
Find all posts by this user
Quote this message in a reply
08-26-2014, 04:49 PM (This post was last modified: 08-26-2014 04:55 PM by patrice.)
Post: #7
patrice Offline
Member
 		Posts: 184
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[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;
Patrice
“Everything should be made as simple as possible, but no simpler.” Albert Einstein
Find all posts by this user
Quote this message in a reply
08-27-2014, 01:52 AM (This post was last modified: 08-27-2014 01:59 AM by compsystems.)
Post: #8
compsystems Offline
Senior Member
 		Posts: 1,402
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;
Find all posts by this user
Quote this message in a reply
08-27-2014, 05:23 AM
Post: #9
Joe Horn Offline
Senior Member
 		Posts: 2,018
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-
Visit this user's website Find all posts by this user
Quote this message in a reply
08-27-2014, 07:15 AM
Post: #10
patrice Offline
Member
 		Posts: 184
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
Find all posts by this user
Quote this message in a reply
08-27-2014, 07:20 AM
Post: #11
patrice Offline
Member
 		Posts: 184
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 Sad
Patrice
“Everything should be made as simple as possible, but no simpler.” Albert Einstein
Find all posts by this user
Quote this message in a reply
08-27-2014, 03:41 PM
Post: #12
patrice Offline
Member
 		Posts: 184
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
Find all posts by this user
Quote this message in a reply
09-05-2014, 04:11 PM
Post: #13
Richard Wagner Offline
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.
Find all posts by this user
Quote this message in a reply
09-07-2014, 07:47 AM
Post: #14
patrice Offline
Member
 		Posts: 184
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.
Thanks for your support.
Patrice
“Everything should be made as simple as possible, but no simpler.” Albert Einstein
Find all posts by this user
Quote this message in a reply
09-19-2015, 11:56 AM
Post: #15
StephenG1CMZ Offline
Senior Member
 		Posts: 1,075
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)
https://my.numworks.com/python/steveg1cmz
Visit this user's website Find all posts by this user
Quote this message in a reply
Post Reply 




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

Contact Us | The Museum of HP Calculators | Return to Top | Return to Content | Lite (Archive) Mode | RSS Syndication