1 |
# RCSid: $Id: do_views3.6.tcl,v 2.8 2003/02/22 02:07:30 greg Exp $ |
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 select from $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 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 |
set viewbox $w.vnl.lb |
103 |
tk_listboxSingleSelect $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 |
-scroll "$w.vo.s set" |
123 |
scrollbar $w.vo.s -relief sunken -orient horiz -command "$w.vo.e view" |
124 |
pack $w.vo.e $w.vo.s -side top -fill x |
125 |
place $w.vo -relwidth .6429 -relheight .1000 -relx .2857 -rely .2439 |
126 |
helplink $w.vo.e trad views options |
127 |
# View change buttons |
128 |
button $w.vclr -text Clear -width 7 -relief raised \ |
129 |
-command "set viewname {} ; set viewopts {} |
130 |
focus $w.vne |
131 |
catch {unset viewseln} |
132 |
$w.vnl.lb select clear" |
133 |
place $w.vclr -relx .4643 -rely .1220 |
134 |
helplink $w.vclr trad views clear |
135 |
button $w.vdef -text "Set Default" -width 12 \ |
136 |
-relief raised -state disabled -command {addview 0} |
137 |
place $w.vdef -relx .6429 -rely .1220 |
138 |
helplink $w.vdef trad views default |
139 |
set vdefbutt $w.vdef |
140 |
button $w.vadd -text Add -width 7 -relief raised -command addview |
141 |
place $w.vadd -relx .2857 -rely .3659 |
142 |
helplink $w.vadd trad views add |
143 |
button $w.vchg -text Change -width 7 -relief raised \ |
144 |
-command {addview [delview]} |
145 |
place $w.vchg -relx .4643 -rely .3659 |
146 |
helplink $w.vchg trad views change |
147 |
button $w.vdel -text Delete -width 7 -relief raised -command delview |
148 |
place $w.vdel -relx .6429 -rely .3659 |
149 |
helplink $w.vdel trad views delete |
150 |
# Up vector |
151 |
label $w.upl -text Up: |
152 |
place $w.upl -relx .0714 -rely .4878 |
153 |
radiobutton $w.upxp -text +X -variable radvar(UP) -value X -relief flat |
154 |
place $w.upxp -relx .2857 -rely .4634 |
155 |
radiobutton $w.upxn -text -X -variable radvar(UP) -value -X -relief flat |
156 |
place $w.upxn -relx .2857 -rely .5244 |
157 |
radiobutton $w.upyp -text +Y -variable radvar(UP) -value Y -relief flat |
158 |
place $w.upyp -relx .4286 -rely .4634 |
159 |
radiobutton $w.upyn -text -Y -variable radvar(UP) -value -Y -relief flat |
160 |
place $w.upyn -relx .4286 -rely .5244 |
161 |
radiobutton $w.upzp -text +Z -variable radvar(UP) -value Z -relief flat |
162 |
place $w.upzp -relx .5714 -rely .4634 |
163 |
radiobutton $w.upzn -text -Z -variable radvar(UP) -value -Z -relief flat |
164 |
place $w.upzn -relx .5714 -rely .5244 |
165 |
helplink "$w.upxp $w.upxn $w.upyp $w.upyn $w.upzp $w.upzn" \ |
166 |
trad views up |
167 |
# Picture file name |
168 |
label $w.pfl -text Picture: |
169 |
place $w.pfl -relx .0714 -rely .6345 |
170 |
entry $w.pfe -textvariable radvar(PICTURE) -relief sunken |
171 |
place $w.pfe -relwidth .5714 -relheight .0610 -relx .2857 -rely .6345 |
172 |
helplink $w.pfe trad views picture |
173 |
# Resolution |
174 |
label $w.rzl -text Resolution: |
175 |
place $w.rzl -relx .0714 -rely .7107 |
176 |
entry $w.rze -textvariable radvar(RESOLUTION) -relief sunken |
177 |
place $w.rze -relwidth .2857 -relheight .0610 -relx .2857 -rely .7107 |
178 |
helplink $w.rze trad views resolution |
179 |
# Rawfile |
180 |
label $w.rfl -text Rawfile: |
181 |
place $w.rfl -relx .0714 -rely .7870 |
182 |
entry $w.rfe -textvariable radvar(RAWFILE) -relief sunken |
183 |
place $w.rfe -relwidth .5714 -relheight .0610 -relx .2857 -rely .7870 |
184 |
helplink $w.rfe trad views rawfile |
185 |
# Zfile |
186 |
label $w.zfl -text Zfile: |
187 |
place $w.zfl -relx .0714 -rely .8632 |
188 |
entry $w.zfe -textvariable radvar(ZFILE) -relief sunken |
189 |
place $w.zfe -relwidth .5714 -relheight .0610 -relx .2857 -rely .8632 |
190 |
helplink $w.zfe trad views zfile |
191 |
# Revert and Copy buttons |
192 |
button $w.revert -text Revert -relief raised \ |
193 |
-command "copyviews $rifname" |
194 |
place $w.revert -relwidth .1071 -relheight .0610 -relx .98 -rely .98 \ |
195 |
-anchor se |
196 |
helplink $w.revert trad views revert |
197 |
button $w.copy -text Copy -relief raised -command {getfile -grab \ |
198 |
-send copyviews -view view_txt -glob $myglob(rif)} |
199 |
place $w.copy -relwidth .1071 -relheight .0610 -relx .98 -rely .90 \ |
200 |
-anchor se |
201 |
helplink $w.copy trad views copy |
202 |
# Assign focus |
203 |
bind $w.vne <Return> "focus $w.vo.e" |
204 |
bind $w.vo.e <Return> "addview ; $w.vclr invoke" |
205 |
bind $w.vo.e <B2-Motion> {} |
206 |
bind $w.vo.e <Button-2> "$w.vo.e insert insert \[selection get\]" |
207 |
$w.vclr invoke |
208 |
# Track variables |
209 |
vnchange viewname {} w |
210 |
trace variable viewname w vnchange |
211 |
if [info exists radvar(view)] { |
212 |
viewchange radvar view w |
213 |
trace variable radvar(view) wu viewchange |
214 |
} else { |
215 |
viewchange radvar view u |
216 |
} |
217 |
} |