## L-system 2D

GS 2010-06-06:

L-system is a mathematical formalism proposed by the Hungarian biologist Aristid Lindenmayer in 1968 to describe the growth patterns of plants. It is used in computer graphics for realistic modelling of plants and to draw fractals.

L-systems is a syntactic sets of rules and symbols, i.e. a language, that models growth processes. It uses Logo-style turtle graphics . A complex structure is defined recursively by a text substitution scheme with a geometric interpretation.

Turtle interpretation:

F
Move forward a step and draw a line
f
Move forward a step without drawing a line
+
Rotate counterclockwise by an angle
-
Rotate clockwise by an angle
[
Push data into stack
]
Pop data outside stack

Jeff Smith 2019-08-27 : Below is an online demo using CloudTk

## Implementation

```# lsystem2d.tcl
# Author:      Gerard Sookahet
# Date:        06 Jun 2010
# Description: 2D Lindemeyer system (L-system) to draw factal curves
#              from a formal grammar

package require Tk 8.5
package require tile

bind all <Escape> {exit}

# -------------------------------------------------
# Define grammar
proc DefineGrammar {} {
variable grammar

set alphabet {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890+-[]}
for {set i 0} {\$i < [string length \$alphabet]} {incr i} {
set grammar([string index \$alphabet \$i]) {}
}

set grammar(F)  DrawObject
set grammar(+)  RotateLeft
set grammar(-)  RotateRight
set grammar(\[) PushData
set grammar(\]) PopData
set grammar(f)  MoveForward
}

# -------------------------------------------------
# Stack procedures
proc Push e {
variables stack top
set stack(\$top) \$e
incr top
}

proc Pop {} {
variables stack top
if {\$top == 0} return {}
incr top -1
set e \$stack(\$top)
unset stack(\$top)
return \$e
}

# -------------------------------------------------
# F : move forward a step and draw a line
proc DrawObject {} {
variables x0 y0 step a0 lcoord
set a [expr {.01745329 * \$a0}]
set x1 [expr {\$x0 + \$step * cos(\$a)}]
set y1 [expr {\$y0 - \$step * sin(\$a)}]
lappend lcoord \$x0 \$y0 \$x1 \$y1
set x0 \$x1
set y0 \$y1
}

# + : rotate counterclockwise by an angle
proc RotateLeft {} {
variables angle a0
set a0 [expr {\$a0 + \$angle}]
}

# - : rotate clockwise by an angle
proc RotateRight {} {
variables angle a0
set a0 [expr {\$a0 - \$angle}]
}

# f : move forward a step without drawing a line
proc MoveForward {} {
variables x0 y0 step a0
set a [expr {.01745329 * \$a0}]
set x1 [expr {\$x0 + \$step * cos(\$a)}]
set y1 [expr {\$y0 - \$step * sin(\$a)}]
set x0 \$x1
set y0 \$y1
}

# [ : push data into stack
proc PushData {} {
variables x0 y0 step angle a0
Push \$x0
Push \$y0
Push \$step
Push \$a0
Push \$angle
}

# ] : pop data outside stack
proc PopData {} {
variables x0 y0 step angle a0
set angle [Pop]
set a0    [Pop]
set step  [Pop]
set y0    [Pop]
set x0    [Pop]
}

# -------------------------------------------------
# Perform iteration over the rules
# Parse the result
proc Production {w iterations axiom} {
variables grammar trules lcoord
variables x0 y0 a0 name

\$w.c delete all

set x \$x0
set y \$y0
set a \$a0
set rules {}
set lcoord {}

for {set i 1} {\$i <= 3} {incr i} {
lappend rules \$trules(v,\$i) \$trules(p,\$i)}

for {set i 0} {\$i < \$iterations} {incr i} {
foreach {v p} \$rules {
set axiom [string map [list \$v \$p] \$axiom[set axiom {}]]
}
}
for {set i 0} {\$i < [string length \$axiom]} {incr i} {
eval \$grammar([string index \$axiom \$i])
}

Draw \$lcoord
set x0 \$x
set y0 \$y
set a0 \$a
}

# -------------------------------------------------
# Init parameters
proc Init {} {
variables x0 y0 step angle a0 name lcoord W H w
variables iterations lsys stack top
variables axiom rules trules

catch {unset stack}
set lcoord {}

set W 512
set H 512

for {set i 1} {\$i <= 3} {incr i} {
set trules(v,\$i) {}
set trules(p,\$i) {}
}
set name {}
set angle 60
set step 400
set x0 0
set y0 -235
set a0 60

set iterations 3
set axiom F++F++F
set rules {F {F-F++F-F}}
set i 0

foreach {v p} \$rules {
incr i
set trules(v,\$i) \$v
set trules(p,\$i) \$p
}

set top 0
array set stack {}
set stack(\$top) 0
}

# -------------------------------------------------
# Define optimal view and draw lsystem
proc Draw { l } {
variables W H

set lx {}
set ly {}

foreach {x0 y0 x1 y1} \$l {
lappend lx \$x0 \$x1
lappend ly \$y0 \$y1
}
set lx [lsort -real \$lx]
set ly [lsort -real \$ly]
set maxx [lindex \$lx end]
set minx [lindex \$lx 0]
set maxy [lindex \$ly end]
set miny [lindex \$ly 0]

set Dx [expr {\$maxx - \$minx}]
set Dy [expr {\$maxy - \$miny}]

set w [expr {\$W / \$Dx}]
set h [expr {\$H / \$Dy}]

foreach {x0 y0 x1 y1} \$l {
set xx0 [expr {\$w * (\$x0 - \$minx)}]
set yy0 [expr {\$h * (\$y0 - \$miny)}]
set xx1 [expr {\$w * (\$x1 - \$minx)}]
set yy1 [expr {\$h * (\$y1 - \$miny)}]
.lsys.c create line \$xx0 \$yy0 \$xx1 \$yy1 -width 1 -fill darkgreen
}
}

# -------------------------------------------------
# Examples
variable designs
variables x0 y0 step angle a0 name
variables iterations axiom rules trules

\$w.c delete all
Init
set name \$s

lassign [dict get \$designs \$s] vars axiom rules
lassign \$vars[set vars {}] iterations step angle a0 x0 y0

\$w.c create text 10 10 -anchor w -text \$name
set i 0
foreach {v p} \$rules {
incr i
set trules(v,\$i) \$v
set trules(p,\$i) \$p
}
}

catch {destroy \$w}
toplevel \$w
wm title \$w {About lsystem 2D}
message \$w.msg -justify center -aspect 250 -relief sunken -bg blue \
-fg white -text "2D Lsystem\n\nGerard Sookahet\n\nJune 2010"
button \$w.bquit -text { OK } -command {destroy .about}
eval pack [winfo children \$w]
}

proc Main {} {
variable designs
variables x0 y0 step angle a0 W H w
variables iterations axiom lsys rules trules

set w .lsys
catch {destroy \$w}
toplevel \$w
wm withdraw .
wm title \$w {Lsystem 2D}
wm geometry \$w +100+10

pack [canvas \$w.c -width \$W -height \$H -bg white]

set f1 [frame \$w.f1 -relief ridge -borderwidth 2]
pack \$f1 -fill x
label \$f1.l1 -text X0
entry \$f1.e1 -width 7 -textvariable x0
label \$f1.l2 -text { Y0}
entry \$f1.e2 -width 7 -textvariable y0
label \$f1.l3 -text { Step}
entry \$f1.e3 -width 4 -textvariable step
label \$f1.l4 -text { Angle}
entry \$f1.e4 -width 4 -textvariable angle
label \$f1.l5 -text { A0}
entry \$f1.e5 -width 4 -textvariable a0
label \$f1.l6 -text { iterations}
entry \$f1.e6 -width 4 -textvariable iterations
eval pack [winfo children \$f1] -side left

set f2 [frame \$w.f2 -relief ridge -borderwidth 2]
pack \$f2 -fill x
set f21 [frame \$f2.f21 -borderwidth 2]
label \$f21.l1 -text Axiom
entry \$f21.e1 -width 14 -textvariable axiom
label \$f21.l2 -text { }
set l [dict keys \$designs]
ttk::combobox \$f21.sp -values \$l -textvariable lsys
\$f21.sp set {Koch snowflake}
bind \$f21.sp <<ComboboxSelected>> {ReadData \$w \$lsys}

grid \$f21.l1 -column 0 -row 1
grid \$f21.e1 -column 1 -row 1
grid \$f21.l2 -column 0 -row 2
grid \$f21.sp -columnspan 2 -row 3
set f22 [frame \$f2.f22 -borderwidth 2]
label \$f22.l1 -text rules_1
entry \$f22.ev1 -width 6  -textvariable trules(v,1)
entry \$f22.ep1 -width 44 -textvariable trules(p,1)
label \$f22.l2  -text rules_2
entry \$f22.ev2 -width 6  -textvariable trules(v,2)
entry \$f22.ep2 -width 44 -textvariable trules(p,2)
label \$f22.l3 -text rules_3
entry \$f22.ev3 -width 6  -textvariable trules(v,3)
entry \$f22.ep3 -width 44 -textvariable trules(p,3)
grid \$f22.l1  -column 0 -row 1
grid \$f22.ev1 -column 1 -row 1
grid \$f22.ep1 -column 2 -row 1
grid \$f22.l2  -column 0 -row 2
grid \$f22.ev2 -column 1 -row 2
grid \$f22.ep2 -column 2 -row 2
grid \$f22.l3  -column 0 -row 3
grid \$f22.ev3 -column 1 -row 3
grid \$f22.ep3 -column 2 -row 3
eval pack [winfo children \$f2] -side left

set f4 [frame \$w.f4 -relief sunken -borderwidth 2]
pack \$f4 -fill x
button \$f4.bu -text Run -width 6 -bg blue -fg white \
-command {Production \$w \$iterations \$axiom}
button \$f4.bc -text Clear -width 6 -bg blue -fg white \
-command [list \$w.c delete all]
button \$f4.ba -text About -width 6 -bg blue -fg white -command About
button \$f4.bq -text Quit -width 5 -bg blue -fg white -command exit
eval pack [winfo children \$f4] -side left
}

proc variables args {
set script {}
foreach arg \$args {
append script [list variable \$arg]\n
}
uplevel \$script
}

variable designs {
{Koch snowflake} {
{3 400 60 60 0 -235}
F++F++F
{F {F-F++F-F}}
}

{3 3 90 0 0 0}
F-F-F-F
{F {FF-F-F-F-F-F+F}}
}

{Koch star} {
{3 1 60 0 0 0}
F++F++F
{F {F+F--F+F}}
}

{Koch curve 3} {
{3 1 90 0 0 0}
F-F-F-F
{F {FF-F+F-F-FF}}
}

Shrub {
{6 230 90 0 0 -230}
X
{
F {FF}
X {F[+X]F[+X]-X}
}
}

Bush {
{3 1 16 0 0 0}
++++F
{F {FF-[-F+F+F]+[+F-F-F]}}
}

Island {
{2 1 90 90 0 0}
F+F+F+F
{
F {F+f-FF+F+FF+Ff+FF-f+FF-F-FF-Ff-FFF}
f {ffffff}
}
}

{4 1 60 0 0 0}
YF
{
X {YF+XF+Y}
Y {XF-YF-X}
}
}

{5 1 60 0 0 0}
X
{
F {FF}
X {--FXF++FXF++FXF--}
}
}

{5 1 60 0 0 0}
F--F--F
{
F {F--F--F--ff}
f {ff}
}
}

{Sierpinski square} {
{4 1 90 0 0 0}
F-F-F-F
{
F {FF[-F-F-F]F}
}
}

Pentigree {
{3 1 72 0 0 0}
F-F-F-F-F
{
F {F-F++F+F-F-F}
}
}

Hiwaymed {
{3 1 8 0 0 0}
-X
{
X {X+F+Y}
Y {X-F-Y}
}
}

Hilbert {
{4 1 90 0 0 0}
X
{
X {+YF-XFX-FY+}
Y {-XF+YFY+FX-}
}
}

Segment32 {
{2 1 90 0 0 0}
F
{
F {-F+F-F-F+F+FF-F+F+FF+F-F-FF+FF-FF+F+F-FF-F-F+FF-F-F+F+F-F+}
}
}

{Square curve} {
{5 1 90 0 0 0}
X
{
X {XF-F+F-XF+F+XF-F+F-X}
}
}

{Heighway dragon} {
{8 1 90 45 0 0}
FX
{
X {X+YF}
Y {FX-Y}
}
}

{Levy C curve} {
{11 1 45 0 0 0}
F
{
F {+F--F+}
}
}

{Plant 1} {
{5 1 25 90 0 0}
X
{
X {F-[[X]+X]+F[+FX]-X}
F {FF}
}
}

{Plant 2} {
{6 1 20 70 256 0}
X
{
X {F[+X]F[-X]+X}
F {FF}
}
}

Carpet {
{4 1 90 0 256 512}
F-F-F-F
{
F {F[F]-F+F[--F]+F-F}
}
}

{Penrose snowflake} {
{3 1 18 0 0 0}
F----F----F----F----F
{
F {F----F----F----------F++F----F}
}
}

}

DefineGrammar
Init
Main```

PYK 2012-06-13
Code refactor.