1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
## -*- tcl -*-
# ### ### ### ######### ######### #########
# Canvas Behavior Module. Highlighting items and groups of items.
# ### ### ### ######### ######### #########
## Requisites
package require Tcl 8.5
package require Tk
# ### ### ### ######### ######### #########
## API
namespace eval ::canvas::highlight {
namespace export \
on off
namespace ensemble create
}
proc ::canvas::highlight::on {c tagOrId cmdprefix} {
# Setting up a general highlight, with the items to highlight
# identified by <tagOrId> and <cmdprefix> providing the 'on' and 'off'
# methods invoked to (de)activate highlight. The cmdprefix is
# fully responsible for how the highlightging of a particular
# handle is handled.
# Install the bindings doing the highlight
$c bind $tagOrId <Any-Enter> [namespace code [list Highlight $c $cmdprefix %x %y]]
$c bind $tagOrId <Any-Leave> [namespace code [list Unhighlight $c $cmdprefix %x %y]]
return
}
proc ::canvas::highlight::off {c tagOrId} {
# Remove a highlight identified by canvas <c> and <tagOrId>.
# Find and remove the bindings for this particular combination of
# canvas and tagOrId.
$c bind $tagOrId <Any-Enter> {}
$c bind $tagOrId <Any-Leave> {}
return
}
# ### ### ### ######### ######### #########
## Highlight execution.
proc ::canvas::highlight::Highlight {c cmdprefix x y} {
# Check that highlight is not active
variable active
if {[info exists active]} return
# Start a highlight operation, import remainder of state
variable clientdata
# Get item under mouse, if any.
set item [$c find withtag current]
if {$item eq {}} return
# Initialize the highlight state, run the command to initialize
# anything external to us. We remember the current location to
# enable the delta calculations in 'Move'.
set active $cmdprefix
set clientdata [{*}$active on $c $item]
return
}
proc ::canvas::highlight::Unhighlight {c cmdprefix x y} {
# Check for active highlight.
variable active
if {![info exists active]} return
# Import remainder of the highlight state
variable clientdata
# Let the commnand process the movement as it sees fit.
# Must return a boolean. False vetos the unhighlight.
if {![{*}$active off $c $clientdata]} return
# Clear highlight state
unset -nocomplain active clientdata
return
}
# ### ### ### ######### ######### #########
## Convenience. Highlightging via ...
# ### ### ### ######### ######### #########
## State.
namespace eval ::canvas::highlight {
# State of a highlight in progress
variable active ; # command prefix to invoke for 'on' / 'off'.
variable clientdata ; # Result of invoking 'on', data for 'off'.
}
# ### ### ### ######### ######### #########
## Ready
package provide canvas::highlight 0.1
return
# ### ### ### ######### ######### #########
## Scrap yard.
|
