blob: 3144e21421e9c8710a2f520180698e2715c7d0f6 (
plain) (
blame)
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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
################################################################################
# CURSOR CENTEROID AND AUTO-REGISTER FUNCTIONS.
################################################################################
# Set the centroiding box size.
set ctid 0
set cid 0
proc cbxDestroy args \
{
global centerBoxSize cid ctid
catch {
if {$ctid != 0} {
send cbm$cid destroy
deleteTimedCallback $ctid
set ctid 0
}
}
}
proc setCtrBoxSize { x y delta args } \
{
global centerBoxSize cid ctid
global cpXscale cpYscale
incr centerBoxSize $delta
if {$centerBoxSize <= 1} { set centerBoxSize 1 }
# Kill off any old markers before drawing the new one.
catch {
if {$ctid != 0} {
send cbm$cid destroy
deleteTimedCallback $ctid
set ctid 0
}
}
# create a transient marker indicating the centering box and post a
# callback to delete it in about a second.
incr cid
send imagewin createMarker cbm$cid \
type box \
createMode noninteractive \
lineColor red \
x $x \
y $y \
width [expr $cpXscale * $centerBoxSize] \
height [expr $cpXscale * $centerBoxSize] \
activated True \
visible True \
sensitive False
set ctid [ postTimedCallback cbxDestroy 500]
}
# Box size is half-width of the marker size. Value is the slider value.
set focusBoxSize $winWidth
set focusValue 100.0
set fid 0
set ftid 0
set moving 0
proc setFocusBoxSize { sz args } \
{
global focusBoxSize fid ftid focusValue moving
global winWidth winHeight
if { $moving == 0 } {
return done
}
if { $winWidth < $winHeight } {
set max [expr $winWidth / 2 - 64]
} else {
set max [expr $winHeight / 2 - 64]
}
set focusBoxSize [expr 64 + ($sz * $max) - 1]
#send client setOption cmfocus [expr ($focusBoxSize / 2)]
send client setOption cmfocus $focusBoxSize
# Destroy any existing markers.
catch {
if {$ftid != 0} {
send fm$fid destroy
set ftid 0
}
}
# create a transient marker indicating the centering box and post a
# callback to delete it in about a second.
incr fid
send imagewin createMarker fm$fid \
type box \
createMode noninteractive \
lineColor green \
lineWidth 4 \
x [expr $winWidth / 2] \
y [expr $winHeight / 2] \
width $focusBoxSize \
height $focusBoxSize \
activated True \
visible True \
sensitive False
set ftid [ postTimedCallback fbxDestroy 500]
set moving 0
}
proc fbxDestroy args \
{
global fid ftid moving
catch {
if {$ftid != 0} {
send fm$fid destroy
set ftid 0
}
}
}
proc setFocusSize { widget cbtype x y } \
{
global focusValue ftid moving
# Only update once we've stopped the movement.
if { $x == $focusValue && $moving == 1 } {
set ftid [ postWorkProc setFocusBoxSize $x ]
} else {
set moving 1
}
set focusValue $x
} ; send focusSlider addCallback setFocusSize scroll
# Compute a centroid offset for the current position to peak-up on the
# feature.
proc centroid { x y type args } \
{
global centerBoxSize
global cpXscale cpYscale
# Convert to image coords.
set sz [expr "int ($centerBoxSize * $cpXscale)"]
# Get the centroid position.
if {$type != "min"} {
if {[send peakupButton get on]} {
set center [ send client centroid $x $y $sz ]
} else {
set center [ send client centroid $x $y $sz max ]
}
} else {
set center [ send client centroid $x $y $sz min ]
}
# Now reposition the cursor.
set xoff [lindex $center 0 ]
set yoff [lindex $center 1 ]
move_cursor $xoff $yoff
}
# Set the auto-register center offset position
proc offset { x y args } \
{
global frame blinkFrames auto_reg
global frameCenterX frameCenterY
global frameOffsetX frameOffsetY
# No-op of auto-register isn't on.
if { $auto_reg == 0 } {
Wexec client "Auto-Register is not enabled!"
return
}
# If we're not in the blink frames list ignore the request.
if { [string first $frame $blinkFrames] == -1 } {
Wexec client "Frame not in current\nregister list."
return
}
set rx $x; set ry $y
set raster 0
# Convert raw screen coordinates to frame buffer raster coordinates.
send imagewin unmapPixel $x $y raster rx ry
# Select a pixel.
set xoff [expr "int ($rx) - $frameCenterX($frame)" ]
set yoff [expr "int ($ry) - $frameCenterY($frame)" ]
set frameOffsetX($frame) $xoff
set frameOffsetY($frame) $yoff
# Adjust the display.
send client setOffset $xoff $yoff
}
|
