[GS] (20100606) L-system is a mathematical formalism proposed by the hungarian biologist Aristid Lindenmayer in 1968 to describe the growth patterns of plants [http://en.wikipedia.org/wiki/L-system]. It is used in computer graphics for realistic modelling of plants and to draw fractals. [http://gersoo.free.fr/wiki/f1808/lsystem2d.jpg] L-systems is a syntactic sets of rules and symbols (a language) that models growth processes. It uses a turtle graphics as the Logo programming language does it. A complex structure is defined recursively by a text susbtitution 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 - ====== # 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 {exit} # ------------------------------------------------- # Define grammar proc DefineGrammar {} { global 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 } { global stack top set stack($top) $e incr top } proc Pop {} { global 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 {} { global 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 {} { global angle a0 set a0 [expr $a0 + $angle] } # - : rotate clockwise by an angle proc RotateRight {} { global angle a0 set a0 [expr $a0 - $angle] } # f : move forward a step without drawing a line proc MoveForward {} { global 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 {} { global x0 y0 step angle a0 Push $x0 Push $y0 Push $step Push $a0 Push $angle } # ] : pop data outside stack proc PopData {} { global 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} { global grammar trules lcoord global 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 { regsub -all $v $axiom $p 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 {} { global x0 y0 step angle a0 name lcoord W H w global iterations lsys stack top global 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 } { global 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} { global x0 y0 step angle a0 name global iterations axiom rules trules $w.c delete all Init set name $s switch -exact $s { "Koch snowflake" { lassign {3 400 60 60 0 -235} iterations step angle a0 x0 y0 set axiom F++F++F set rules {F {F-F++F-F}} } "Koch quadratic" { lassign {3 3 90 0 0 0} iterations step angle a0 x0 y0 set axiom F-F-F-F set rules {F {FF-F-F-F-F-F+F}} } "Koch star" { lassign {3 1 60 0 0 0} iterations step angle a0 x0 y0 set axiom F++F++F set rules {F {F+F--F+F}} } "Koch curve 3" { lassign {3 1 90 0 0 0} iterations step angle a0 x0 y0 set axiom F-F-F-F set rules {F {FF-F+F-F-FF}} } Shrub { lassign {6 230 90 0 0 -230} iterations step angle a0 x0 y0 set axiom X set rules {F {FF} \ X {F[+X]F[+X]-X}} } Bush { lassign {3 1 16 0 0 0} iterations step angle a0 x0 y0 set axiom ++++F set rules {F {FF-[-F+F+F]+[+F-F-F]}} } Island { lassign {2 1 90 90 0 0} iterations step angle a0 x0 y0 set axiom F+F+F+F set rules {F {F+f-FF+F+FF+Ff+FF-f+FF-F-FF-Ff-FFF} \ f {ffffff}} } Arrowhead { lassign {4 1 60 0 0 0} iterations step angle a0 x0 y0 set axiom YF set rules {X {YF+XF+Y} \ Y {XF-YF-X}} } "Sierpinski gasket" { lassign {5 1 60 0 0 0} iterations step angle a0 x0 y0 set axiom X set rules {F {FF} \ X {--FXF++FXF++FXF--}} } "Sierpinski gasket 1" { lassign {5 1 60 0 0 0} iterations step angle a0 x0 y0 set axiom F--F--F set rules {F {F--F--F--ff} \ f {ff}} } "Sierpinski square" { lassign {4 1 90 0 0 0} iterations step angle a0 x0 y0 set axiom F-F-F-F set rules {F {FF[-F-F-F]F}} } Pentigree { lassign {3 1 72 0 0 0} iterations step angle a0 x0 y0 set axiom F-F-F-F-F set rules {F {F-F++F+F-F-F}} } Hiwaymed { lassign {3 1 8 0 0 0} iterations step angle a0 x0 y0 set axiom -X set rules {X {X+F+Y} \ Y {X-F-Y}} } Hilbert { lassign {4 1 90 0 0 0} iterations step angle a0 x0 y0 set axiom X set rules {X {+YF-XFX-FY+} \ Y {-XF+YFY+FX-}} } Segment32 { lassign {2 1 90 0 0 0} iterations step angle a0 x0 y0 set axiom F set rules {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" { lassign {5 1 90 0 0 0} iterations step angle a0 x0 y0 set axiom X set rules {X {XF-F+F-XF+F+XF-F+F-X}} } "Heighway dragon" { lassign {8 1 90 45 0 0} iterations step angle a0 x0 y0 set axiom FX set rules {X {X+YF} \ Y {FX-Y}} } "Levy C curve" { lassign {11 1 45 0 0 0} iterations step angle a0 x0 y0 set axiom F set rules {F {+F--F+}} } "Plant 1" { lassign {5 1 25 90 0 0} iterations step angle a0 x0 y0 set axiom X set rules {X {F-[[X]+X]+F[+FX]-X} \ F {FF}} } "Plant 2" { lassign {6 1 20 70 256 0} iterations step angle a0 x0 y0 set axiom X set rules {X {F[+X]F[-X]+X} \ F {FF}} } Carpet { lassign {4 1 90 0 256 512} iterations step angle a0 x0 y0 set axiom F-F-F-F set rules {F {F[F]-F+F[--F]+F-F}} } "Penrose snowflake" { lassign {3 1 18 0 0 0} iterations step angle a0 x0 y0 set axiom F----F----F----F----F set rules {F {F----F----F----------F++F----F}} } } $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 { } { global x0 y0 step angle a0 W H w global 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 {"Koch snowflake" "Koch quadratic" "Koch star" "Koch curve 3" \ Shrub Bush Island Arrowhead \ "Sierpinski gasket" "Sierpinski gasket 1" "Sierpinski square" \ Hilbert Pentigree Segment32 "Heighway dragon" "Levy C curve" \ "Square curve" "Plant 1" "Plant 2" Carpet "Penrose snowflake"} ttk::combobox $f21.sp -values $l -textvariable lsys $f21.sp set "Koch snowflake" bind $f21.sp <> {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 "$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 } DefineGrammar Init Main ====== ---- See also: * [Artificial life] <> Toys | Graphics | Mathematics | Biology