[GS] 2010-06-06: [http://en.wikipedia.org/wiki/L-system%|%L-system] is a mathematical formalism proposed by the Hungarian biologist [https://en.wikipedia.org/wiki/Aristid_Lindenmayer%|%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 [https://en.wikipedia.org/wiki/Turtle_graphics%|%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] 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 {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 <> {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]: <> Toys | Graphics | Mathematics | Biology | Fractal