L-system 2D

 

GS (20100606) Un L-system est une formalisme mathématique inventé par le le biologiste hongrois Aristid Lindenmayer (1926-1989) en 1968 pour décrire la croissance des plantes [1]. Celui-ci est utilisé en infographie pour modéliser des plantes réalistes ou des fractales.

Un L-system est un ensemble de règles et de symboles syntaxiques (un langage) qui modélise les processus de croissance. Il utilise une tortue graphique comme le langage de programmation Logo. Une structure complexe est définie récursivement par un schéma de substitution de texte avec une interprétation géométrique.

Interprétation de la tortue:

 F : Se déplacer d’un pas et tracer
 f : Se déplacer d’un pas sans tracer
 + : Tourner à gauche d’un angle
 - : Tourner à droite d’un angle
 [ : Sauvegarder la position courante
 ] : Restaurer la dernière position sauvegardée

-

 # 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 {} {
     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 <<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 "$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

Catégorie Mathématiques