# 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 room <Enter> {.c itemconfig current -fill yellow; .l config -text [string map {current "" room ""} [.c gettags current]]} .c bind room <Leave> {.c itemconfig current -fill white; .l config -text ""}