Arjen Markus (12 february 2018) The program below is an attempt to create a facility to interactively put items on a canvas. For the moment it does not do much more than allowing you to define a circle or a rectangle, but it is easy to expand it for any of the standard types of canvas items. My intention is not to make a new full-fledged graphical editor, but rather to provide a small tool that can be used flexibly. For instance, I fairly often use the canvas to sketch a drawing or a schema and most of the time I do that by typing the object creation commands, test the results and edit the code to improve the drawing until the result is to my liking. That is a rather tedious procedure and I hope the code below will allow me to accelerate such editing. Mind you, it is not intended for highly detailed drawings.
As for the code below: I use TclOO to keep track of all manner of variables - they should not bother the user - and the drawing procedures are "modal" by using the vwait command. I needed some of the introspection commands of TclOO to achieve this all, but it works and it is convenient.
# canvasEdit.tcl --
# Straightforward implementation of a package to edit
# objects on the canvas graphically.
#
#
# First: can I link a global variable with an object variable?
#
::oo::class create canvasEdit {
variable location
variable canvas
variable typeHandler
variable coords
variable item
constructor {_canvas} {
variable location
variable canvas
variable item
set canvas $_canvas
bind $canvas <Motion> [list [self object] handleMove %x %y]
bind $canvas <ButtonPress> [list [self object] handlePress %x %y]
set item ""
}
method handleMove {x y} {
variable location
variable typeHandler
set location "X, Y: $x, $y"
my $typeHandler Move $x $y
}
method handlePress {x y} {
variable location
variable typeHandler
set location "X, Y: $x, $y"
my $typeHandler Press $x $y
}
method link {varname} {
variable location
upvar #0 $varname [namespace which -variable location]
}
method edit {type} {
variable typeHandler
variable wait
variable item
if { $type ni [info object methods [self object] -all] } {
return -code error "Unknown canvas object type: $type"
}
set item ""
set typeHandler $type
vwait [namespace which -variable wait]
set typeHandler Default
return $item
}
method Default {event x y} {
# Nothing to do
}
method circle {event x y} {
variable canvas
variable item
variable coords
variable wait
if { $event eq "Move" } {
if { $item ne "" } {
lassign $coords xc yc
set dx [expr {$x-$xc}]
set dy [expr {$y-$yc}]
set rad [expr {hypot($dx,$dy)}]
set xtop [expr {$xc - $rad}]
set ytop [expr {$yc - $rad}]
set xbottom [expr {$xc + $rad}]
set ybottom [expr {$yc + $rad}]
$canvas coords $item $xtop $ytop $xbottom $ybottom
} else {
return
}
} else {
if { $item ne "" } {
# We have two points, so we are done
set wait 1
} else {
# We have a centre
set coords [list $x $y]
set item [$canvas create oval [expr {$x-2}] [expr {$y-2}] [expr {$x+2}] [expr {$y+2}]]
}
}
}
method rectangle {event x y} {
variable canvas
variable item
variable coords
variable wait
if { $event eq "Move" } {
if { $item ne "" } {
lassign $coords xtop ytop
$canvas coords $item $xtop $ytop $x $y
} else {
return
}
} else {
if { $item ne "" } {
# We have two points, so we are done
set wait 1
} else {
# We have a centre
set coords [list $x $y]
set item [$canvas create rectangle $x $y [expr {$x+2}] [expr {$y+2}]]
}
}
}
}
grid [canvas .c] -sticky news
grid [label .l -textvariable mytext -relief sunken] -sticky news
set e [canvasEdit new .c]
$e link mytext ;# This enables us to see the primitive text containing the current coordinates
catch {
console show
}
# This will provoke an error - there is no "lattice" handler
#$e edit lattice
# Now we can edit a circle and get the canvas item ID for it
#puts [$e edit circle]
puts [$e edit rectangle]