blob: 13f5bed84b0ab1212005456cb4758e8a78207142 (
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
203
204
205
206
207
208
209
210
211
212
213
214
215
|
################################################################################
# Compass indicator procedures.
################################################################################
set compassColor 207 ;# normally this is yellow
set last_compass [send compass get on] ;# save compass state
proc drawCompass args \
{
global ism_enable frame frameCache compassColor Compass Orient
global panner_x panner_y panner_width panner_height cur_objid
global redraw_compass last_compass
if {! [send compass get on]} \
return
eraseCompass ;# erase the old compass
if {! [info exists frameCache($frame)] } {
set id -1
} elseif {$cur_objid != [lindex $frameCache($frame) 1]} {
set id [lindex $frameCache($frame) 1]
} else {
set id $cur_objid
}
if { [info exists Compass($id)] } {
set angle [lindex $Compass($id) 0]
set north_x [lindex $Compass($id) 1]
set north_y [lindex $Compass($id) 2]
set east_x [lindex $Compass($id) 3]
set east_y [lindex $Compass($id) 4]
set transpose [lindex $Compass($id) 5]
set xlab [lindex $Compass($id) 6]
set ylab [lindex $Compass($id) 7]
} else {
set north_x 0.0 ; set north_y 1.0
set east_x 1.0 ; set east_y 0.0
set xlab X ; set ylab Y
set angle 0.0 ; set transpose 0
set Compass($id) { 0.0 1.0 0.0 1.0 0.0 0 X Y }
}
set xflip 1
set yflip 1
# Adjust the compass for the display orientation (e.g. image sections
# used to flip an image during display).
if { [info exists Orient($id)] } {
set xflip [expr $xflip * [lindex $Orient($id) 1] ]
set yflip [expr $yflip * [lindex $Orient($id) 2] ]
}
# Get the panner center position.
set pcx [expr ($panner_x + $panner_width / 2)]
set pcy [expr ($panner_y + $panner_height / 2)]
# Setup for the overlay.
send imagewin getLogRes sv_xl sv_yl
send imagewin getPhysRes sv_xp sv_yp
send imagewin setLogRes $sv_xp $sv_yp
send imagewin setLineWidth 2
set xflip [ expr ($xflip * ([send xflipButton get state] ? -1 : 1))]
set yflip [ expr ($yflip * ([send yflipButton get state] ? -1 : 1))]
# Normalized compass points. The first row are the axes, second is
# the pointer head, and last are the X/Y label coords. Assumes a
# zero rotation with North up and East left, or standard X/Y orientation.
set cpoints {
{-1 0} {0 0} {0 -1}
{-0.07 -0.85} {0 -1} {0.07 -0.85} {-0.07 -0.85}
{-1.2 0} {0 -1.2}
}
# Get rotation and scale factors.
set angle [expr "atan2($north_y,$north_x)"]
set coso [expr "cos (-$angle)"]
set sino [expr "sin (-$angle)"]
set scale [expr ([min $panner_width $panner_height] * 0.3)]
# Initialize the drawing points.
set pts {}
set cpoints { }
lappend cpoints [list $east_x $east_y ]
lappend cpoints [list 0 0]
lappend cpoints [list $north_x $north_y]
foreach p $cpoints {
# Get the scaled position.
set sx [expr ($scale * [lindex $p [expr "($transpose > 0) ? 1 : 0"]])]
set sy [expr ($scale * [lindex $p [expr "($transpose > 0) ? 0 : 1"]])]
# Translate to the scaled position.
set rx [expr int($pcx + $sx + 0.5)]
set ry [expr int($pcy - $sy + 0.5)]
# Now handle the axis flip.
set rx [expr (($xflip < 0) ? ($pcx + ($pcx - $rx)) : $rx)]
set ry [expr (($yflip < 0) ? ($pcy + ($pcy - $ry)) : $ry)]
lappend pts $rx $ry
}
set rpoints { }
set hpoints { {0.0 0.0} {-0.1 -0.07} {-0.1 0.07} {0.0 0.0} }
foreach p $hpoints {
# Break out the position.
set sx [lindex $p [expr "($transpose > 0) ? 1 : 0"]]
set sy [lindex $p [expr "($transpose > 0) ? 0 : 1"]]
# Do the rotation of the head at the origin.
set rx [expr ($north_x + ($sx * $coso + $sy * $sino))]
set ry [expr ($north_y - ($sx * $sino + $sy * $coso))]
lappend rpoints [list $rx $ry]
}
foreach p $rpoints {
# Get the scaled position.
set sx [expr ($scale * [lindex $p [expr "($transpose > 0) ? 1 : 0"]])]
set sy [expr ($scale * [lindex $p [expr "($transpose > 0) ? 0 : 1"]])]
# Translate to the scaled position.
set rx [expr int($pcx + $sx + 0.5)]
set ry [expr int($pcy - $sy + 0.5)]
# Now handle the axis flip.
set rx [expr (($xflip < 0) ? ($pcx + ($pcx - $rx)) : $rx)]
set ry [expr (($yflip < 0) ? ($pcy + ($pcy - $ry)) : $ry)]
lappend pts $rx $ry
}
set lpoints { }
lappend lpoints [list [expr "$east_x-0.2"] $east_y ]
lappend lpoints [list $north_x [expr "$north_y+0.2"] ]
foreach p $lpoints {
# Get the scaled position.
set sx [expr ($scale * [lindex $p [expr "($transpose > 0) ? 1 : 0"]])]
set sy [expr ($scale * [lindex $p [expr "($transpose > 0) ? 0 : 1"]])]
# Translate to the scaled position.
set rx [expr int($pcx + $sx + 0.5)]
set ry [expr int($pcy - $sy - 0.5)]
# Now handle the axis flip.
set rx [expr (($xflip < 0) ? ($pcx + ($pcx - $rx)) : $rx)]
set ry [expr (($yflip < 0) ? ($pcy + ($pcy - $ry)) : $ry)]
lappend pts $rx $ry
}
# Draw the compass axes.
set compassPts [lrange $pts 0 5]
send imagewin setColorIndex $compassColor
send imagewin drawPolyline $compassPts
# Draw the compass pointer.
set head [lrange $pts 6 13]
send imagewin setFillType solid
send imagewin drawPolygon $head
# Draw the labels.
send imagewin drawAlphaText [lindex $pts 14] [lindex $pts 15] $xlab
send imagewin drawAlphaText [lindex $pts 16] [lindex $pts 17] $ylab
send imagewin setLogRes $sv_xl $sv_yl
set redraw_compass 0
} ; foreach w {xflip yflip} { send $w addCallback drawCompass }
# This is a kludge to redraw the compass after it is erased when displaying
# a new image. Once the user moves the mouse back into the main window we'll
# do the redraw.
send imagewin addEventHandler drawCompass enterWindowMask
proc createCompassMarker { pts args } \
{
set cm_points { }
lappend cm_points [lrange $pts 0 1]
lappend cm_points [lrange $pts 2 3]
lappend cm_points [lrange $pts 4 5]
print [list $cm_points]
}
proc eraseCompass args \
{
global panner_mapping
send imagewin refreshMapping $panner_mapping
}
proc toggleCompass { widget type state args } \
{
global last_compass
if {$state} {
drawCompass
set last_compass True
} else {
eraseCompass
set last_compass False
}
} ; send compass addCallback toggleCompass
|
