[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]
<<inlinehtml>>
<iframe height="6570" width="65800" src="https://cloudtk.tcl-lang.org/cloudtk/VNC?session=new&Tk=L-system-2D" allowfullscreen></iframe>
<<inlinehtml>>
----
** 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]:
<<categories>> Toys | Graphics | Mathematics | Biology | Fractal