[willdye] On 2005-08-12, [dkf] posted some example code on the Tcl'ers chat, for the
benefit of a new person who was asking basic questions about things like the [canvas] widget.
The code below is derived from [dkf]'s original example code.
It should create a small display of several rooms.
As the mouse moves into a room, an <Enter> event should be triggered,
and the name of the room should appear in a label.
As the mouse moves out of the room, a <Leave> event should be triggered,
and the label should be blanked out.
----
======
# Example of using 'bind' to trigger procs on <Enter> and <Leave> events.
proc makeRoom {widget name polyCoords} {
set id [$widget create poly $polyCoords -fill white -outline black]
$widget bind $id <Enter> [list enterRoom $widget $id $name]
$widget bind $id <Leave> [list leaveRoom $widget $id]
$widget scale $id 0 0 20 20 }
proc enterRoom {widget id name} {
$widget itemconfigure Title -text $name
$widget itemconfigure $id -fill yellow }
proc leaveRoom {widget id} {
$widget itemconfigure Title -text ""
$widget itemconfigure $id -fill white }
proc start {widget} {
destroy $widget ; pack [canvas $widget -background white]
makeRoom $widget "Bedroom" {1 1 4 1 4 3 1 3}
makeRoom $widget "Kitchen" {5 1 9 1 9 3 5 3}
makeRoom $widget "Hallway" {4 1 5 1 5 3 9 3 9 4 1 4 1 3 4 3}
makeRoom $widget "Recroom" {9 4 9 9 1 7 1 4}
$widget create text 40 10 -tag Title }
start .c
======
----
This example is nearly equivalent, but even shorter,
albeit at the expense of being less general,
and binding to compound inline commands.
----
======
# This is an example of binding compound, inline commands to mouse events.
# Note that the use of double quotes here is considered dangerous. It allows
# $id and $name to be dereferenced, but in non-trival code the subtleties of
# quoting and substitution are such that it's generally much better to bind
# to procedure calls such as: .c bind $id <Enter> [list entry_proc $id $name]
proc create_room {name coordinates} {
set id [.c create polygon $coordinates -fill white -outline black]
.c scale $id 0 0 29 20
.c bind $id <Enter> ".c itemconfig $id -fill yellow; .l config -text $name"
.c bind $id <Leave> ".c itemconfig $id -fill white; .l config -text {}" }
destroy .c .l
pack [label .l -background white] -fill x
pack [canvas .c -background white]
create_room "Bedroom" {1 1 4 1 4 3 1 3}
create_room "Kitchen" {5 1 9 1 9 3 5 3}
create_room "Hallway" {4 1 5 1 5 3 9 3 9 4 1 4 1 3 4 3}
create_room "Recroom" {9 4 9 9 1 7 1 4}
======
[APE] 04/06/2018
Hereafter a slightly different version which make use of tags (and also removes the tag current for display) :
======
proc create_room {name coordinates} { set id [.c create polygon $coordinates -fill white -outline black -tags "room $name"]
.c scale $id 0 0 29 20
}
destroy .c .l
pack [label .l -background white] -fill x
pack [canvas .c -background white]
create_room "Bedroom" {1 1 4 1 4 3 1 3}
create_room "Kitchen" {5 1 9 1 9 3 5 3}
create_room "Hallway" {4 1 5 1 5 3 9 3 9 4 1 4 1 3 4 3}
create_room "Recroom" {9 4 9 9 1 7 1 4}
.c bind allroom <Enter> {.c itemconfig current -fill yellow; .l config -text [string map {current "" room ""} [.c gettags current]]}
.c bind allroom <Leave> {.c itemconfig current -fill white; .l config -text ""}
======
<<categories>> Example | Graphics | GUI