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\nDecember 2009" 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