A Tiny Line Drawing Program

[Sun Home | Tcl Plugin | Demos]

Here's a little line drawing program. Start drawing by pressing the left mouse button, then draw a line by moving the mouse. When you release the left mouse button, the line gets entered into the canvas. You can delete a line by pressing the DEL key while the mouse is over a line.

Source:

Here's source for the line drawing program:

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 <Button-1> {StrokeBegin %W %x %y}
bind .c <B1-Motion> {Stroke %W %x %y}
bind .c <ButtonRelease-1> {StrokeEnd %W %x %y}
bind .c <Delete> {%W delete [%W find closest %x %y]}
.c bind line <Enter> {%W itemconfigure [%W find closest %x %y] -fill blue}
.c bind line <Leave> {%W itemconfigure [%W find closest %x %y] -fill red}
pack .c
focus .c