Version 4 of A tiny drawing program

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.

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 ::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 ::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 ::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-2] -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}

#-- With little more coding, the Fill mode allows changing an item's fill color:

 proc down(Fill) {w x y} {$w itemconfig current -fill $::Fill}
 proc move(Fill) {w x y} {}

#-- Building the UI

 set modes {Draw Move Fill 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 retrieved 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 }