Source code:




# ------------------------------------------------------------
# A demo application using the canvas widget that lets the user
# draw line objects with the mouse. This demo is included in 
# the standard release of Tcl/Tk
#
#  Freely modifiable/redistributable under the "Standard Tcl License"
#  See http://www.eolas.com/tcl/license.txt for details
# ------------------------------------------------------------



proc StrokeBegin {w x y} {
    global stroke
    catch {unset stroke}
    set stroke(N) 0
    set stroke(0) [list $x $y]
}
proc Stroke {w x y} {
    global 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 blue}
}
proc StrokeEnd {w x y} {
    global stroke
    set points {}
    for {set i 0} {$i <= $stroke(N)} {incr i} {
	append points $stroke($i) " "
    }
    $w delete segments
    eval {$w create line} $points \
	{-smooth true -tag line -fill red -width 5}
}

canvas .c -width 400 -height 400 -highlightt 0 \
		-background bisque
bind .c  {StrokeBegin %W %x %y}
bind .c  {Stroke %W %x %y}
bind .c  {StrokeEnd %W %x %y}
bind .c  {%W delete [%W find closest %x %y]}
.c bind line  {%W itemconfigure \
		[%W find closest %x %y] \
		-fill blue}
.c bind line  {%W itemconfigure \
		[%W find closest %x %y] \
		-fill red}
pack .c
focus .c