Version 11 of L-system 2D

Updated 2018-04-29 08:21:41 by dbohdan

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.

lsystem2d.jpg

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

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
proc ReadData {w s} {
    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
    }
}

proc About {} {
    set w .about
    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}}
    }

    {Koch quadratic} {
        {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}
        }
    }

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

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

    {Sierpinski gasket 1} {
        {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

Change Log

PYK 2012-06-13
Code refactor.

See Also

Artificial life