HP Prime for All
English
Русский
HP Apps : Lindenmayer Fractals
| Name | Lindenmayer Fractals |
| Description | Uses the Lindenmayer System to build fractals on screen, with 28 Lindenmayer fractals. |
| Author | Patrice Torchet |
Source code (download):
Source code formatted by website engine
ICON resource lines were stripped.
// 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) * …
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 c…
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+…
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;