[GS] 2010-01-08: This little demo, draw a tree with interactive parameters controls 
such as tree height, trunk bending, branch level or angle.

[growingtree-ttk-win10.png]
----
[Jeff Smith] Below is an online demo using [CloudTk]

<<inlinehtml>>

<iframe height="450" width="650" src="https://cloudtk.tcl-lang.org/cloudtk/VNC?session=new&Tk=Growing-tree" allowfullscreen></iframe>

<<inlinehtml>>

----
======
#! /bin/env tclsh

# growingtree.tcl
# Author:      Gerard Sookahet
# Date:        08 Jan 2010
# Description: Draw an interactive tree with controls.
# Changelog:   2018-04-26: Code reformatted by pooryorick.
#              2018-04-29: Updated by dbohdan to use Ttk widgets and
#              namespace variables instead of globals, and handle resizing.

package require Tk 8.5

namespace eval growingtree {
    variable lcolor {
        #00ff00
        #00e500
        #00cc00
        #00b200
        #009900
        #007f00
        #006600
        #004c00
        #003300
        #001900
    }
    variable bendangle0 9
    variable bendangle $bendangle0
    variable branchangle0 60
    variable branchangle $branchangle0
    variable branchratio .4
    variable height 2.6
    variable rdepth 5
    variable trunkratio .2
}

proc growingtree::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"
    ttk::button $w.bquit -text { OK } -command {destroy .about}
    pack $w.msg
    pack $w.bquit -pady 5
}

proc growingtree::UpdateScaleVar {w varName resolution value} {
    upvar 1 $varName var
    set var [expr {int($value) * $resolution}]
    RedrawTree $w
}

proc growingtree::TreeScale {w path varName text from to resolution} {
    upvar 1 $varName var
    set qualVarName [namespace current]::$varName
    ttk::label ${path}_info -text $text
    ttk::label ${path}_value -textvariable $qualVarName
    ttk::scale $path \
        -from [expr {$from / $resolution}] \
        -to [expr {$to / $resolution}] \
        -value [expr {$var / $resolution}] \
        -length 360 \
        -orient horiz \
        -command [list \
            [namespace current]::UpdateScaleVar \
            $w \
            $qualVarName \
            $resolution \
        ]
}

proc growingtree::Main N {
    variable bendangle0
    variable branchangle0
    variable branchratio
    variable H
    variable height
    variable lcolor
    variable rdepth
    variable trunkratio

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

    set f0 [frame $w.f0]
    pack [canvas $w.c -width $N -height $N -bg white] \
        -side left \
        -fill both \
        -expand 1
    pack $f0 -side right -fill both

    set H $N
    RedrawTree $w

    set f1 [ttk::frame $f0.f1]
    pack $f1 -fill x

    TreeScale $w $f1.sc1 rdepth       {branch level}    1   10     1
    TreeScale $w $f1.sc2 bendangle0   {bend angle}    -60   60     1
    TreeScale $w $f1.sc3 branchangle0 {branch angle}    0  180     1
    TreeScale $w $f1.sc4 trunkratio   {trunk ratio}     0  0.7  0.01
    TreeScale $w $f1.sc5 branchratio  {branch ratio}  0.1  2.0   0.1
    TreeScale $w $f1.sc6 height       {tree height}   0.1  4.0   0.1
    pack {*}[winfo children $f1] -padx 10

    set f3 [ttk::frame $f0.f3]
    pack $f3 -fill x
    ttk::button $f3.ba -text About -width 6 -command [namespace code About]
    ttk::button $f3.bq -text Quit -width 5 -command exit
    pack {*}[winfo children $f3] -side left -padx 5 -pady 5
}

proc growingtree::DrawTree {w xo yo a r level} {
    variable bendangle
    variable branchangle
    variable branchratio
    variable height
    variable lcolor
    variable trunkratio

    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 growingtree::RedrawTree w {
    variable bendangle
    variable bendangle0
    variable branchangle
    variable branchangle0
    variable H
    variable height
    variable lcolor
    variable rdepth

    $w.c delete all

    set rad 0.0174532925
    set bendangle   $bendangle0
    set branchangle $branchangle0

    DrawTree $w 200 400 90 [expr {($H - 200)*$height}] $rdepth
}

# If this is the main script...
if {[info exists argv0] && ([file tail [info script]] eq [file tail $argv0])} {
    bind all <Escape> {exit}
    growingtree::Main 400
}
======


<<categories>> Demo | Fractal | Tk | Visualization