[GS] (20100108) This little demo, draw a tree with interactive parameters controls 
such as tree height, trunk bending, branch level or angle.

Développement d'un arbre

[GS] (20100108) Cette petit démo, dessine un arbre dont certains paramètres, tels que 
la hauteur, la courbure du tronc, le degré de ramification ou les angles des branches, 
sont controlables interactivement.

[http://wfr.tcl.tk/fichiers/images/gtree.jpg]


 # growingtree.tcl
 # Author:      Gerard Sookahet
 # Date:        08 Jan 2010
 # Description: Draw an interactive tree with controls

 package require Tk

 bind all <Escape> {exit}

 proc About {} {
  set w .about
  catch {destroy $w}
  toplevel $w
  wm title $w "About growingtree"
  message $w.msg -justify center -aspect 250 -relief sunken -bg blue -fg white \
         -text "growingtree\n\nGerard Sookahet\n\nJanuary 2010"
  button $w.bquit -text " OK " -command {destroy .about}
  eval pack [winfo children $w]
 }

 proc Init {w} {
     global lcolor
     global rdepth bendangle0 branchangle0 trunkratio branchratio
     global bendangle branchangle 
     global height H

  set rdepth 5
  set bendangle0 9
  set branchangle0 60
  set trunkratio .2
  set branchratio .4
  set height 2.6
  set lcolor {}
 
  set bendangle $bendangle0
  set branchangle $branchangle0

  set lcolor {#00ff00 #00e500 #00cc00 #00b200 #009900 #007f00 #006600 #004c00 #003300 #001900}
 
  DrawTree $w 200 400 $branchangle0 [expr {($H-200)*$height}] $rdepth
 }

 proc Main { N } {
     global lcolor
     global rdepth bendangle0 branchangle0 trunkratio branchratio
     global height H 

  set w .itree
  catch {destroy $w}
  toplevel $w
  wm withdraw .
  wm title $w "Growing tree"
  wm geometry $w +10+10
  $w config -bg darkblue

  set f0 [frame $w.f0]
  pack [canvas $w.c -width $N -height $N -bg white] $f0 -side left

  set H $N
  Init $w

  set f1 [frame $f0.f1 -relief sunken -bd 1]
  pack $f1 -fill x
  scale $f1.sc1 -from 1 -to 10 -length 360 -resolution 1 -label "branch level" \
                -orient horiz -bd 1 -showvalue true -variable rdepth \
                -command "RedrawTree $w"
  scale $f1.sc2 -from -60 -to 60 -length 360 -resolution 1 -label "bend angle" \
                -orient horiz -bd 1 -showvalue true -variable bendangle0  \
                -command "RedrawTree $w"
  scale $f1.sc3 -from 0 -to 180 -length 360 -resolution 1 -label "branch angle" \
                -orient horiz -bd 1 -showvalue true -variable branchangle0 \
                -command "RedrawTree $w"
  scale $f1.sc4 -from 0 -to 0.7 -length 360 -resolution 0.01 -label "trunk ratio" \
                -orient horiz -bd 1 -showvalue true -variable trunkratio \
                -command "RedrawTree $w"
  scale $f1.sc5 -from 0.1 -to 2.0 -length 360 -resolution 0.1 -label "branch ratio" \
                -orient horiz -bd 1 -showvalue true -variable branchratio \
                -command "RedrawTree $w"
  scale $f1.sc6 -from 0.1 -to 4.0 -length 360 -resolution 0.1 -label "tree height" \
                -orient horiz -bd 1 -showvalue true -variable height \
                -command "RedrawTree $w"
  eval pack [winfo children $f1] 

  set f3 [frame $f0.f3 -relief sunken -bd 1]
  pack $f3 -fill x
  button $f3.ba -text About -width 6 -bg blue -fg white -command About
  button $f3.bq -text Quit -width 5 -bg blue -fg white -command exit
  eval pack [winfo children $f3] -side left
 }
 
 proc DrawTree {w xo yo a r level} {
     global lcolor
     global bendangle branchangle trunkratio branchratio height 
 
  set rad 0.0174532925
  set arad [expr {$a*$rad}]
  set rtr  [expr {$r*$trunkratio}]
 
  set x [expr {$xo + cos($arad)*$rtr}]
  set y [expr {$yo - sin($arad)*$rtr}]
 
  $w.c create line $xo $yo $x $y -fill [lindex $lcolor $level] -width $level 
  if {$level > 0} then {
    incr level -1
    set a [expr {$a + $bendangle}]
    set rbr [expr {$r*$branchratio}]
    DrawTree $w $x $y [expr {$a - $branchangle}] $rbr $level
    DrawTree $w $x $y [expr {$a + $branchangle}] $rbr $level
    DrawTree $w $x $y $a [expr {(1 - $trunkratio)*$r}] $level
  }
 }

 proc RedrawTree {w v} {
     global lcolor
     global rdepth bendangle0 branchangle0 bendangle branchangle 
     global height H 

  $w.c delete all

  set rad 0.0174532925
  set bendangle   $bendangle0
  set branchangle $branchangle0
 
  DrawTree $w 200 400 90 [expr {($H-200)*$height}] $rdepth
 }
 
 Main 400