# ---------------------------------------------------------------------- # A demo application using the canvas widget and embedded buttons. # This application combines two other demos, the strokes and oval # application. # # Freely modifiable/redistributable under the "Standard Tcl License" # See http://www.eolas.com/tcl/license.txt for details # ---------------------------------------------------------------------- proc begin {w x y} { global thing global stroke global ovallocation if {$thing == "stroke"} { set stroke(N) 0 set stroke(0) [list $x $y] } else { set ovallocation(xorig) $x set ovallocation(yorig) $y set tx [expr $x + 1] set ty [expr $y + 1] set ovallocation(obj) \ [$w create oval $x $y $tx $ty -fill purple] } } proc go {w x y} { global thing global stroke global ovallocation if {$thing =="stroke"} { set last $stroke($stroke(N)) incr stroke(N) set stroke($stroke(N)) [list $x $y] eval {$w create line} $last \ {$x $y -tag segments -fill green} } else { $w delete $ovallocation(obj) set ovallocation(obj) \ [$w create oval $ovallocation(xorig) \ $ovallocation(yorig) \ $x $y -fill purple] } } proc end {w x y} { global thing global stroke global ovallocation if {$thing =="stroke"} { set points {} for {set i 0} {$i <= $stroke(N)} {incr i} { append points $stroke($i) " " } $w delete segments if {[llength $points] < 4} { } else { eval {$w create line} $points \ {-smooth 1 -tag line -fill green -width 5} } } else { $w delete $ovallocation(obj) set ovallocation(obj) \ [$w create oval $ovallocation(xorig) \ $ovallocation(yorig) \ $x $y -fill yellow -tag oval] }} proc press_button { tag } { global thing if {$tag == "oval"} { .b1 configure -relief sunken .b2 configure -relief raised set thing oval } else { .b2 configure -relief sunken .b1 configure -relief raised set thing stroke } } proc clear { } { .c delete line .c delete oval } canvas .c -height 500 -width 500 -background white pack .c button .b1 -text Ovals -background white \ -command {press_button oval} button .b2 -text Strokes -background white \ -command {press_button stroke} button .b3 -text Clear -background white -command clear set thing oval .c create window 0 0 -window .b1 \ -anchor nw -tag obutton .c create window 60 0 -window .b2 \ -anchor nw -tag sbutton .c create window 130 0 -window .b3 \ -anchor nw -tag clearbutton bind .c {begin %W %x %y} bind .c {go %W %x %y} bind .c {end %W %x %y} bind .c {%W delete [%W find closest %x %y]} .b1 configure -relief sunken