Tcl/Tk Cookbook - Canvas Revisited Tcl/Tk Cookbook - Canvas RevisitedScript
We want to add some bindings to the canvas widget so that :
To do this, set the three bindings for the canvas:
bind .can{GetStarted %x %y} bind .can { LetGo %x %y} bind .can {KeepMoving %x %y}
Each user event invokes the associated action (procedure/function/behaviour) passing it the current x,y position as argument. The script for the three procedures are defined below:
proc GetStarted {x y} {
global x1 y1 sb so str eo
set x1 $x
set y1 $y
if {[string compare $sb "text"] == 0 } {
set so [.can create text $x $y -text $str -anchor sw]
return
}
if { [string compare $sb "obj"] == 0} {
set so [.can create rectangle $x $y $x $y -fill {} -outline red]
set eo $so
return
}
if {[string compare $sb "line"] == 0 } {
set so [.can create $sb $x1 $y1 $x $y ]
.can addtag $sb$so enclosed $x1 $y1 $x $y
} else {
set so [.can create $sb $x1 $y1 $x $y -fill {} -outline black ]
.can addtag $sb$so enclosed $x1 $y1 $x $y
}
}
proc KeepMoving {x y} {
global x1 y1 so sb
if {[string compare $sb "text"] == 0 } {
return
}
.can coords $so $x1 $y1 $x $y
}
proc LetGo {x y} {
global x1 y1 so sb eo
if { [string compare $sb "obj"] == 0} {
set so [.can find enclosed $x1 $y1 $x $y]
.can itemconfigure $so -fill {} -outline green
.can delete $eo
}
}
The procedure "GetStarted" checks the current value of "sb". If the chosen primitive is text, then the string item is drawn anchored southwest at current location specified by x,y values.
If "sb" points to the "select an object", then a rectangle object is created with red outline and the variable "eo" is set to this rectangle's id (to be used later to delete it selectively).
In all the other cases the object/item is drawn from x,y (top left) to x1,y1 (bottom right corner). A tag name made of concatenating the value of "sb" and the objects unique id is added using the widget command .can with action addtag.
The procedure "KeepMoving" returns without doing anything if "sb" is "text" as it is not relevant in this case. In all other cases, the widget command .can is invoks the coordinates action. The first argument to this action is the object id (or tag). If no further arguments is specified, this action will return a list of the coordinates of the object. If the action is given some coordinate values then it will modify/reset the coordinates of the object (first argument) to those of the given values.
If "sb" is set to "obj" then the procedure "LetGo" invokes ".can" to find the identity of any enclosed object/item. If an enclosed object/item is found its border is reset to green colour using the canvas widget action itemconfigure.
See what happens when you the selected item is a text string.
proc CutSelection {} {
global so
.can delete $so
}
proc clearCanvas {} {
foreach id [.can find all] { .can delete $id }
}
proc printCanvas {} {
.can postscript -file "canvas.ps"
}
"CutSelection" deletes the currently selected or most recently drawn item.
The procedure "clearCanvas" gets the display list of all items and deletes them one by one.
In "printCanvas", the Tk canvas widget action postscript is invoked with a "-file" option. A postscript of the canvas contents will be saved in the file "canvas.ps" in the current working directory. Note that Tk will complain if you have no write permissions in the current working directory.
