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 of course move items
around. Right-click to delete an item.

[http://mini.net/files/tinydraw.jpg]

A ''radio'' is an obvious "megawidget" to hold a row of [radiobutton]s.
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 {
----
[Category Toys] | [Arts and crafts of Tcl-Tk programming]
}