| 1 |
greg |
2.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 |
greg |
2.4 |
set n [lsearch -exact $radvar(view) $viewname] |
| 47 |
|
|
if {$n < 0} { |
| 48 |
|
|
set n [lsearch -glob $radvar(view) "$viewname *"] |
| 49 |
|
|
} |
| 50 |
greg |
2.1 |
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 |
greg |
2.6 |
load_vars [file tail $rf] {view UP PICTURE RESOLUTION RAWFILE ZFILE} |
| 84 |
greg |
2.1 |
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 |
greg |
2.6 |
place $w.pfl -relx .0714 -rely .6345 |
| 170 |
greg |
2.1 |
entry $w.pfe -textvariable radvar(PICTURE) -relief sunken |
| 171 |
greg |
2.6 |
place $w.pfe -relwidth .5714 -relheight .0610 -relx .2857 -rely .6345 |
| 172 |
greg |
2.1 |
helplink $w.pfe trad views picture |
| 173 |
|
|
# Resolution |
| 174 |
|
|
label $w.rzl -text Resolution: |
| 175 |
greg |
2.6 |
place $w.rzl -relx .0714 -rely .7107 |
| 176 |
greg |
2.1 |
entry $w.rze -textvariable radvar(RESOLUTION) -relief sunken |
| 177 |
greg |
2.6 |
place $w.rze -relwidth .2857 -relheight .0610 -relx .2857 -rely .7107 |
| 178 |
greg |
2.1 |
helplink $w.rze trad views resolution |
| 179 |
greg |
2.6 |
# 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 |
greg |
2.1 |
# 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 |
greg |
2.2 |
button $w.copy -text Copy -relief raised -command {getfile -grab \ |
| 198 |
greg |
2.7 |
-send copyviews -view view_txt -glob $myglob(rif)} |
| 199 |
greg |
2.1 |
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 |
greg |
2.3 |
bind $w.vo.e <Return> "addview ; $w.vclr invoke" |
| 205 |
greg |
2.1 |
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 |
|
|
} |
