# Copyright (C) 2014 by Alexandru Cojocaru # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program. If not, see . global width, height global svgfile ## turtle graphics global tx, ty, tlen global tangle, tangleinc global txst, tyst, tanglest global tactions procedure tinit (x, y, l, a, ai) tx := x ty := y tlen := l tangle := a tangleinc := ai txst := [] tyst := [] tanglest := [] end procedure svgline (x1, y1, x2, y2) write (svgfile, "") end procedure tline () x := cos (tangle) * tlen y := sin (tangle) * tlen svgline (tx, ty, tx + x, ty - y) tx +:= x ty -:= y end procedure tmove () x := cos (tangle) * tlen y := sin (tangle) * tlen tx +:= x ty -:= y end procedure tpush () push (txst, tx) push (tyst, ty) push (tanglest, tangle) end procedure tpop () tx := pop (txst) ty := pop (tyst) tangle := pop (tanglest) end procedure tturnl () tangle -:= tangleinc end procedure tturnr () tangle +:= tangleinc end procedure tnull () end procedure turtle (cmds) every i := 1 to *cmds do tactions[cmds[i]] () end ## L-system eval procedure Leval (str, rules) c := "" every i := 1 to *str do c ||:= \rules[str[i]] | str[i] return c end ## some fractals procedure Lkochcurve () tinit (0, height/2, 8, dtor (0), dtor (90)) rules := table () rules["F"] := "F+F-F-F+F" str := "F" every 1 to 4 do str := Leval (str, rules) turtle (str) end procedure Lsierpinski () tinit (0, height, 2, dtor (0), dtor (60)) rules := table () rules["F"] := "G-F-G" rules["G"] := "F+G+F" str := "F" every 1 to 8 do str := Leval (str, rules) turtle (str) end procedure Lplant1 () tinit (width/2, height, 7, dtor (75), dtor (22.5)) rules := table () rules["0"] := "F-[[0]+0]+F[+F0]-0" rules["F"] := "FF" str := "0" every 1 to 5 do str := Leval (str, rules) turtle (str) end procedure Lplant2 () tinit (width/2, height, 10, dtor (80), dtor (22.5)) rules := table () rules["F"] := "FF-[-F+F+F]+[+F-F-F]" str := "F" every 1 to 4 do str := Leval (str, rules) turtle (str) end procedure Ldragoncurve () tinit (width/2, height/2, 4, dtor (0), dtor (90)) rules := table () rules["0"] := "0+1F" rules["1"] := "F0-1" str := "F0" every 1 to 12 do str := Leval (str, rules) turtle (str) end procedure Lhexgospercurve () tinit (width/2, height/2, 6, dtor (60), dtor (60)) rules := table () rules["F"] := "F-G--G+F++FF+G-" rules["G"] := "+F-GG--G-F++F+G" str := "F" every 1 to 4 do str := Leval (str, rules) turtle (str) end procedure svgrun (fn, file) svgfile := open (file, "w") | stop ("cannot open " || file) write (svgfile, "") fn () write (svgfile, "") end procedure main () width := 700 height := 700 tactions := table () tactions["F"] := tactions["G"] := tline tactions["f"] := tactions["g"] := tmove tactions["-"] := tturnl tactions["+"] := tturnr tactions["0"] := tactions["1"] := tactions["2"] := tactions["3"] := tnull tactions["["] := tpush tactions["]"] := tpop svgrun (Lkochcurve, "7_2-koch-curve.svg") svgrun (Lsierpinski, "7_2-sierpinski-triangle.svg") svgrun (Lplant1, "7_2-plant1.svg") svgrun (Lplant2, "7_2-plant2.svg") svgrun (Ldragoncurve, "7_2-dragon-curve.svg") svgrun (Lhexgospercurve, "7_2-hexagonal-gosper-curve.svg") end