if 0 {Richard Suchenwirth 2005-01-01 - As this New Year's Day project, here's a tiny drawing program. Radio buttons on top allow choice of draw mode and fill color. In "Move" mode, you can obviously move items around. Right-click to delete an item.
A radio is an obvious "megawidget" to hold a row of radiobuttons. This simple one allows text or color mode: }
proc radio {w var values {col 0}} { frame $w set type [expr {$col? "-background" : "-text"}] foreach value $values { radiobutton $w.v$value $type $value -variable $var -value $value \ -indicatoron 0 if $col {$w.v$value config -selectcolor $value -borderwidth 3} } eval pack [winfo children $w] -side left set ::$var [lindex $values 0] set w }
if 0 {Depending on draw mode, the mouse events "Down" and "Motion" have different handlers, which are dispatched by names that look like array elements. First for free-hand line drawing:}
proc down(Draw) {w x y} { set ::X $x; set ::Y $y set ::ID [$w create line $x $y $x $y -fill $::Fill] } proc move(Draw) {w x y} { $w coords $::ID [concat [$w coords $::ID] $x $y] }
#-- Movement of an item
proc down(Move) {w x y} { set ::ID [$w find withtag current] set ::X $x; set ::Y $y } proc move(Move) {w x y} { $w move $::ID [expr {$x-$::X}] [expr {$y-$::Y}] set ::X $x; set ::Y $y }
#-- Drawing a rectangle
proc down(Rect) {w x y} { set ::X $x; set ::Y $y set ::ID [$w create rect $x $y $x $y -fill $::Fill] } proc move(Rect) {w x y} { $w coords $::ID [lreplace [$w coords $::ID] 2 3 $x $y] }
#-- Drawing an oval (or circle, if you're careful)
proc down(Oval) {w x y} { set ::X $x; set ::Y $y set ::ID [$w create oval $x $y $x $y -fill $::Fill] } proc move(Oval) {w x y} { $w coords $::ID [lreplace [$w coords $::ID] 2 3 $x $y] }
if 0 {Polygons are drawn by clicking the corners. When a corner is close enough to the first one, the polygon is closed and drawn. }
proc down(Poly) {w x y} { if [info exists ::Poly] { set coords [$w coords $::Poly] foreach {x0 y0} $coords break if {hypot($y-$y0,$x-$x0)<10} { $w delete $::Poly $w create poly [lrange $coords 2 end] -fill $::Fill unset ::Poly } else { $w coords $::Poly [concat $coords $x $y] } } else { set ::Poly [$w create line $x $y $x $y -fill $::Fill] } } proc move(Poly) {w x y} {#nothing}
#-- Building the UI
set modes {Draw Move Rect Oval Poly} set colors { black white magenta brown red orange yellow green green3 green4 cyan blue blue4 purple } grid [radio .1 Mode $modes] [radio .2 Fill $colors 1] -sticky nw grid [canvas .c -relief raised -borderwidth 1] - -sticky news grid rowconfig . 0 -weight 0 grid rowconfig . 1 -weight 1
#-- The current mode is rerieved at runtime:
bind .c <1> {down($Mode) %W %x %y} bind .c <B1-Motion> {move($Mode) %W %x %y} bind .c <3> {%W delete current}
if 0 {For saving images, you need the Img extension, so just omit the following binding if you don't have Img:}
bind . <F1> { package require Img set img [image create photo -data .c] set name [tk_getSaveFile -filetypes {{GIFF .gif} {"All files" *}}\ -defaultextension .gif] if {$name ne ""} {$img write $name; wm title . $name} }
#-- This is an always useful helper in development:
bind . <Escape> {exec wish $argv0 &; exit}
if 0 {