Version 1 of Growing tree

Updated 2010-01-08 17:00:16 by GS

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.

 # 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