A Program To Draw Ovals

[Sun Home | Tcl Plugin | Demos]

Draw some ovals on this canvas. Start drawing with the left mouse button, when you release it the oval is placed on the canvas. Drag an oval with the middle mouse button, and delete an oval by hitting the DEL key while the mouse is over the oval.

Source:

Here's the source for the oval drawing program:

proc startoval {w x y} {
    global ovallocation
    catch {unset ovallocation}
    set ovallocation(xorig) $x
    set ovallocation(yorig) $y
    set tx [expr $x + 1]
    set ty [expr $y + 1]
    set ovallocation(obj) \
	[$w create oval $x $y $tx $ty -fill red -stipple gray25]
}
proc dragoval {w x y} {
    global ovallocation
    $w delete $ovallocation(obj)
    set ovallocation(obj) \
	[$w create oval $ovallocation(xorig) $ovallocation(yorig) \
		$x $y -fill red -stipple gray25]
}
proc endoval {w x y} {
    global ovallocation
    $w delete $ovallocation(obj)
    set ovallocation(obj) \
	[$w create oval $ovallocation(xorig) $ovallocation(yorig) \
		$x $y -fill blue]
    $w addtag tag$ovallocation(obj) withtag $ovallocation(obj)
    $w bind tag$ovallocation(obj) ?> \
	[list %W itemconfigure $ovallocation(obj) -fill yellow]
    $w bind tag$ovallocation(obj) ?> \
	[list %W itemconfigure $ovallocation(obj) -fill blue]
    $w bind tag$ovallocation(obj) ?-2> \
	[list startmove %W $ovallocation(obj) %x %y]
    $w bind tag$ovallocation(obj) ?2-Motion> \
	[list moveoval %W $ovallocation(obj) %x %y]
}
proc startmove {w o x y} {
    global ovallocation
    scan [$w coords $o] "%f %f %f %f" x1 y1 x2 y2
    set ovallocation(x) [expr abs($x - $x1)]
    set ovallocation(y) [expr abs($y - $y1)]
}
proc moveoval {w o x y} {
    global ovallocation
    scan [$w coords $o] "%f %f %f %f" x1 y1 x2 y2
    set dx [expr $x - $x1 - $ovallocation(x)]
    set dy [expr $y - $y1 - $ovallocation(y)]
    $w move $o $dx $dy
}
canvas .c -width 400 -height 400 -background bisque -relief groove \
	  -highlightt 0
bind .c <Button-1> {startoval %W %x %y}
bind .c <B1-Motion> {dragoval %W %x %y}
bind .c <ButtonRelease-1> {endoval %W %x %y}
bind .c <Delete> {%W delete current}
pack .c
focus .c