# 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, "")
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