1 |
# SCCSid "$SunId$ LBL" |
2 |
# |
3 |
# Handle view parameters |
4 |
# |
5 |
|
6 |
proc viewchange {nm el op} { # handle changes to radvar(view) |
7 |
global radvar viewbox viewname viewopts |
8 |
if {"$op" == "u"} { |
9 |
set radvar(view) {} |
10 |
trace variable radvar(view) wu viewchange |
11 |
} |
12 |
$viewbox delete 0 end |
13 |
foreach v $radvar(view) { |
14 |
$viewbox insert end [lindex $v 0] |
15 |
} |
16 |
} |
17 |
|
18 |
proc vnchange {nm el op} { # handle changes to viewname |
19 |
global viewname vdefbutt radvar |
20 |
if {"$viewname" == {}} { |
21 |
$vdefbutt configure -text "Set Default" -state disabled |
22 |
} elseif {$radvar(view) != {} && |
23 |
"[lindex [lindex $radvar(view) 0] 0]" == "$viewname"} { |
24 |
$vdefbutt configure -text "Is Default" -state disabled |
25 |
} else { |
26 |
$vdefbutt configure -text "Set Default" -state normal |
27 |
} |
28 |
} |
29 |
|
30 |
proc selview {} { # change selected view |
31 |
global radvar viewbox viewname viewopts viewseln |
32 |
set viewseln [$viewbox curselection] |
33 |
set viewname [$viewbox get $viewseln] |
34 |
set viewopts [lrange [lindex $radvar(view) $viewseln] 1 end] |
35 |
} |
36 |
|
37 |
proc addview {{pos end}} { # add current view |
38 |
global radvar viewname viewopts curmess viewseln viewbox |
39 |
if {$pos == -1} {return -1} |
40 |
if {[llength $viewname] != 1} { |
41 |
beep |
42 |
set curmess "Illegal view name." |
43 |
return -1 |
44 |
} |
45 |
set curmess {} |
46 |
set n [lsearch -exact $radvar(view) $viewname] |
47 |
if {$n < 0} { |
48 |
set n [lsearch -glob $radvar(view) "$viewname *"] |
49 |
} |
50 |
if {$n >= 0} { |
51 |
set radvar(view) [lreplace $radvar(view) $n $n] |
52 |
if {"$pos" != "end" && $pos > $n} {incr pos -1} |
53 |
} |
54 |
if {"$pos" == "end"} { |
55 |
set viewseln [llength $radvar(view)] |
56 |
lappend radvar(view) "$viewname $viewopts" |
57 |
} else { |
58 |
set viewseln $pos |
59 |
set radvar(view) [linsert $radvar(view) $pos \ |
60 |
"$viewname $viewopts"] |
61 |
} |
62 |
vnchange viewname {} w |
63 |
$viewbox selection anchor $pos |
64 |
return $pos |
65 |
} |
66 |
|
67 |
proc delview {} { # delete current view |
68 |
global radvar viewbox curmess viewseln |
69 |
if {! [info exists viewseln]} { |
70 |
beep |
71 |
set curmess "No view selected for deletion." |
72 |
return -1 |
73 |
} |
74 |
set n $viewseln |
75 |
set curmess {} |
76 |
set radvar(view) [lreplace $radvar(view) $n $n] |
77 |
vnchange viewname {} w |
78 |
unset viewseln |
79 |
return $n |
80 |
} |
81 |
|
82 |
proc copyviews rf { # copy view settings from another RIF |
83 |
load_vars [file tail $rf] {view UP PICTURE EYESEP RESOLUTION RAWFILE ZFILE} |
84 |
vnchange viewname {} w |
85 |
} |
86 |
|
87 |
proc do_views w { # create views screen |
88 |
global radvar viewbox viewseln viewname viewopts vdefbutt rifname |
89 |
if {"$w" == "done"} { |
90 |
trace vdelete radvar(view) wu viewchange |
91 |
trace vdelete viewname w vnchange |
92 |
unset viewbox viewname viewopts vdefbutt |
93 |
return |
94 |
} |
95 |
frame $w |
96 |
# View box |
97 |
label $w.vvl -text Views |
98 |
place $w.vvl -relx .0714 -rely .0610 |
99 |
frame $w.vnl |
100 |
scrollbar $w.vnl.sb -relief sunken -command "$w.vnl.lb yview" |
101 |
listbox $w.vnl.lb -relief sunken -yscroll "$w.vnl.sb set" \ |
102 |
-selectmode browse |
103 |
set viewbox $w.vnl.lb |
104 |
bind $w.vnl.lb <ButtonRelease-1> +selview |
105 |
pack $w.vnl.sb -side right -fill y |
106 |
pack $w.vnl.lb -side left -expand yes -fill both |
107 |
place $w.vnl -relwidth .1786 -relheight .3049 -relx .07143 -rely .1220 |
108 |
helplink $w.vnl.lb trad views list |
109 |
# View name |
110 |
set viewname {} |
111 |
label $w.vnlb -text Name |
112 |
place $w.vnlb -relx .2857 -rely .0610 |
113 |
entry $w.vne -textvariable viewname -relief sunken |
114 |
place $w.vne -relwidth .1429 -relheight .0610 -relx .2857 -rely .1220 |
115 |
helplink $w.vne trad views name |
116 |
# View options |
117 |
set viewopts {} |
118 |
label $w.vol -text Options |
119 |
place $w.vol -relx .2857 -rely .1829 |
120 |
frame $w.vo |
121 |
entry $w.vo.e -textvariable viewopts -relief sunken \ |
122 |
-xscroll "$w.vo.s set" |
123 |
scrollbar $w.vo.s -relief sunken -orient horiz \ |
124 |
-highlightthickness 0 -command "$w.vo.e xview" |
125 |
pack $w.vo.e $w.vo.s -side top -fill x |
126 |
place $w.vo -relwidth .6429 -relheight .1000 -relx .2857 -rely .2439 |
127 |
helplink $w.vo.e trad views options |
128 |
# View change buttons |
129 |
button $w.vclr -text Clear -width 7 -relief raised \ |
130 |
-command "set viewname {} ; set viewopts {} |
131 |
focus $w.vne |
132 |
catch {unset viewseln} |
133 |
$w.vnl.lb selection clear 0 end" |
134 |
place $w.vclr -relx .4643 -rely .1220 |
135 |
helplink $w.vclr trad views clear |
136 |
button $w.vdef -text "Set Default" -width 12 \ |
137 |
-relief raised -state disabled -command {addview 0} |
138 |
place $w.vdef -relx .6429 -rely .1220 |
139 |
helplink $w.vdef trad views default |
140 |
set vdefbutt $w.vdef |
141 |
button $w.vadd -text Add -width 7 -relief raised -command addview |
142 |
place $w.vadd -relx .2857 -rely .3659 |
143 |
helplink $w.vadd trad views add |
144 |
button $w.vchg -text Change -width 7 -relief raised \ |
145 |
-command {addview [delview]} |
146 |
place $w.vchg -relx .4643 -rely .3659 |
147 |
helplink $w.vchg trad views change |
148 |
button $w.vdel -text Delete -width 7 -relief raised -command delview |
149 |
place $w.vdel -relx .6429 -rely .3659 |
150 |
helplink $w.vdel trad views delete |
151 |
# Up vector |
152 |
label $w.upl -text Up: |
153 |
place $w.upl -relx .0714 -rely .4878 |
154 |
radiobutton $w.upxp -text +X -variable radvar(UP) -value X -relief flat |
155 |
place $w.upxp -relx .2857 -rely .4634 |
156 |
radiobutton $w.upxn -text -X -variable radvar(UP) -value -X -relief flat |
157 |
place $w.upxn -relx .2857 -rely .5244 |
158 |
radiobutton $w.upyp -text +Y -variable radvar(UP) -value Y -relief flat |
159 |
place $w.upyp -relx .4286 -rely .4634 |
160 |
radiobutton $w.upyn -text -Y -variable radvar(UP) -value -Y -relief flat |
161 |
place $w.upyn -relx .4286 -rely .5244 |
162 |
radiobutton $w.upzp -text +Z -variable radvar(UP) -value Z -relief flat |
163 |
place $w.upzp -relx .5714 -rely .4634 |
164 |
radiobutton $w.upzn -text -Z -variable radvar(UP) -value -Z -relief flat |
165 |
place $w.upzn -relx .5714 -rely .5244 |
166 |
helplink "$w.upxp $w.upxn $w.upyp $w.upyn $w.upzp $w.upzn" \ |
167 |
trad views up |
168 |
# Eye separation distance |
169 |
label $w.eyl -text Eyesep: |
170 |
place $w.eyl -relx .0714 -rely .6000 |
171 |
entry $w.eye -textvariable radvar(EYESEP) -relief sunken |
172 |
place $w.eye -relwidth .2857 -relheight .0610 -relx .2857 -rely .6000 |
173 |
helplink $w.eye trad views eyesep |
174 |
# Picture file name |
175 |
label $w.pfl -text Picture: |
176 |
place $w.pfl -relx .0714 -rely .6658 |
177 |
entry $w.pfe -textvariable radvar(PICTURE) -relief sunken |
178 |
place $w.pfe -relwidth .5714 -relheight .0610 -relx .2857 -rely .6658 |
179 |
helplink $w.pfe trad views picture |
180 |
# Resolution |
181 |
label $w.rzl -text Resolution: |
182 |
place $w.rzl -relx .0714 -rely .7316 |
183 |
entry $w.rze -textvariable radvar(RESOLUTION) -relief sunken |
184 |
place $w.rze -relwidth .2857 -relheight .0610 -relx .2857 -rely .7316 |
185 |
helplink $w.rze trad views resolution |
186 |
# Rawfile |
187 |
label $w.rfl -text Rawfile: |
188 |
place $w.rfl -relx .0714 -rely .7974 |
189 |
entry $w.rfe -textvariable radvar(RAWFILE) -relief sunken |
190 |
place $w.rfe -relwidth .5714 -relheight .0610 -relx .2857 -rely .7974 |
191 |
helplink $w.rfe trad views rawfile |
192 |
# Zfile |
193 |
label $w.zfl -text Zfile: |
194 |
place $w.zfl -relx .0714 -rely .8632 |
195 |
entry $w.zfe -textvariable radvar(ZFILE) -relief sunken |
196 |
place $w.zfe -relwidth .5714 -relheight .0610 -relx .2857 -rely .8632 |
197 |
helplink $w.zfe trad views zfile |
198 |
# Revert and Copy buttons |
199 |
button $w.revert -text Revert -relief raised \ |
200 |
-command "copyviews $rifname" |
201 |
place $w.revert -relwidth .1071 -relheight .0610 -relx .98 -rely .98 \ |
202 |
-anchor se |
203 |
helplink $w.revert trad views revert |
204 |
button $w.copy -text Copy -relief raised -command {getfile -grab \ |
205 |
-send copyviews -view view_txt -glob $myglob(rif)} |
206 |
place $w.copy -relwidth .1071 -relheight .0610 -relx .98 -rely .90 \ |
207 |
-anchor se |
208 |
helplink $w.copy trad views copy |
209 |
# Assign focus |
210 |
bind $w.vne <Return> "focus $w.vo.e" |
211 |
bind $w.vo.e <Return> "addview ; $w.vclr invoke" |
212 |
bind $w.vo.e <B2-Motion> {} |
213 |
bind $w.vo.e <Button-2> "$w.vo.e insert insert \[selection get\]" |
214 |
$w.vclr invoke |
215 |
# Track variables |
216 |
vnchange viewname {} w |
217 |
trace variable viewname w vnchange |
218 |
if [info exists radvar(view)] { |
219 |
viewchange radvar view w |
220 |
trace variable radvar(view) wu viewchange |
221 |
} else { |
222 |
viewchange radvar view u |
223 |
} |
224 |
} |