ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/util/do_file.tcl
Revision: 2.13
Committed: Fri May 17 13:53:07 1996 UTC (27 years, 11 months ago) by greg
Content type: application/x-tcl
Branch: MAIN
Changes since 2.12: +3 -5 lines
Log Message:
moved globbing patterns to trad.wsh main file

File Contents

# Content
1 # SCCSid "$SunId$ LBL"
2 #
3 # Choose the Rad Input File to work on.
4 #
5
6 proc preen {} { # clean up radvar
7 global radvar rifname
8 foreach n {objects scene materials illum mkillum render oconv pfilt
9 RAWFILE ZFILE AMBFILE OPTFILE EXPOSURE ZONE REPORT} {
10 if {! [info exists radvar($n)]} {
11 set radvar($n) {}
12 }
13 }
14 if [info exists radvar(view)] {
15 set oldval $radvar(view)
16 set radvar(view) {}
17 set n 1
18 foreach v $oldval {
19 if {"[string index $v 0]" == "-"} {
20 lappend radvar(view) "u$n $v"
21 } elseif {[lsearch -glob $radvar(view) \
22 "[lindex $v 0] *"] >= 0} {
23 continue
24 } else {
25 lappend radvar(view) $v
26 }
27 incr n
28 }
29 } else {
30 set radvar(view) {}
31 }
32 if {! [info exists radvar(UP)]} {
33 set radvar(UP) Z
34 } elseif {[string match +* $radvar(UP)]} {
35 set radvar(UP) [string toupper [string range $radvar(UP) 1 end]]
36 } else {
37 set radvar(UP) [string toupper $radvar(UP)]
38 }
39 set rifroot [file rootname [file tail $rifname]]
40 if {! [info exists radvar(OCTREE)]} {
41 set radvar(OCTREE) $rifroot.oct
42 }
43 if {! [info exists radvar(RESOLUTION)]} {
44 set radvar(RESOLUTION) 512
45 }
46 if [info exists radvar(QUALITY)] {
47 cardval radvar(QUALITY) {High Medium Low}
48 } else {
49 set radvar(QUALITY) Low
50 }
51 if {! [info exists radvar(PICTURE)]} {
52 set radvar(PICTURE) $rifroot
53 }
54 if {! [info exists radvar(INDIRECT)]} {
55 set radvar(INDIRECT) 0
56 }
57 if [info exists radvar(DETAIL)] {
58 cardval radvar(DETAIL) {High Medium Low}
59 } else {
60 set radvar(DETAIL) Medium
61 }
62 if [info exists radvar(PENUMBRAS)] {
63 cardval radvar(PENUMBRAS) {True False}
64 } else {
65 set radvar(PENUMBRAS) False
66 }
67 if [info exists radvar(VARIABILITY)] {
68 cardval radvar(VARIABILITY) {High Medium Low}
69 } else {
70 set radvar(VARIABILITY) Low
71 }
72 }
73
74 proc setradvar stmt { # assign a rad variable
75 global radvar
76 regexp {^([a-zA-Z][a-zA-Z0-9]*) *= *(.*)$} $stmt dummy vnam vval
77 switch -glob $vnam {
78 obj* { eval lappend radvar(objects) $vval }
79 sce* { eval lappend radvar(scene) $vval }
80 mat* { eval lappend radvar(materials) $vval }
81 ill* { eval lappend radvar(illum) $vval }
82 mki* { eval lappend radvar(mkillum) $vval }
83 ren* { eval lappend radvar(render) $vval }
84 oco* { eval lappend radvar(oconv) $vval }
85 pf* { eval lappend radvar(pfilt) $vval }
86 vi* { lappend radvar(view) $vval }
87 ZO* { set radvar(ZONE) $vval }
88 QUA* { set radvar(QUALITY) $vval }
89 OCT* { set radvar(OCTREE) $vval }
90 PIC* { set radvar(PICTURE) $vval }
91 AMB* { set radvar(AMBFILE) $vval }
92 OPT* { set radvar(OPTFILE) $vval }
93 EXP* { set radvar(EXPOSURE) $vval }
94 RES* { set radvar(RESOLUTION) $vval }
95 UP { set radvar(UP) $vval }
96 IND* { set radvar(INDIRECT) $vval }
97 DET* { set radvar(DETAIL) $vval }
98 PEN* { set radvar(PENUMBRAS) $vval }
99 VAR* { set radvar(VARIABILITY) $vval }
100 REP* { set radvar(REPORT) $vval }
101 RAW* { set radvar(RAWFILE) $vval }
102 ZF* {set radvar(ZFILE) $vval }
103 }
104
105 }
106
107 proc putradvar {fi vn} { # print out a rad variable
108 global radvar
109 if {! [info exists radvar($vn)] || $radvar($vn) == {}} {return}
110 if [regexp {^[A-Z]} $vn] {
111 puts $fi "$vn= $radvar($vn)"
112 return
113 }
114 if {"$vn" == "view"} {
115 foreach v $radvar(view) {
116 puts $fi "view= $v"
117 }
118 return
119 }
120 if {[lsearch -exact {ZONE QUALITY OCTREE PICTURE AMBFILE OPTFILE
121 EXPOSURE RESOLUTION UP INDIRECT DETAIL PENUMBRAS
122 RAWFILE ZFILE VARIABILITY REPORT} $vn] >= 0} {
123 puts $fi "$vn= $radvar($vn)"
124 return
125 }
126 puts -nonewline $fi "$vn="
127 set vnl [expr [string length $vn] + 1]
128 set pos $vnl
129 for {set i 0} {$i < [llength $radvar($vn)]} {incr i} {
130 set len [expr [string length [lindex $radvar($vn) $i]] + 1]
131 if {$pos > $vnl && $pos + $len > 70} {
132 puts -nonewline $fi "\n$vn="
133 set pos $vnl
134 }
135 puts -nonewline $fi " [lindex $radvar($vn) $i]"
136 incr pos $len
137 }
138 puts $fi {}
139 }
140
141 proc load_vars {f {vl all}} { # load RIF variables
142 global curmess radvar alldone
143 if {"$f" == ""} {return 0}
144 if {! [file isfile $f]} {
145 beep
146 set curmess "$f: no such file."
147 return 0
148 }
149 if {"$vl" == "all" && ! [chksave]} {return 0}
150 set curmess {Please wait...}
151 update
152 if [catch {exec rad -n -w -e $f >& /usr/tmp/ro[pid]}] {
153 set curmess [exec cat /usr/tmp/ro[pid]]
154 exec rm -f /usr/tmp/ro[pid]
155 return 0
156 }
157 set fi [open /usr/tmp/ro[pid] r]
158 if {"$vl" == "all"} {
159 catch {unset radvar}
160 while {[gets $fi curli] != -1} {
161 if [regexp {^[a-zA-Z][a-zA-Z0-9]*= } $curli] {
162 setradvar $curli
163 } else {
164 break
165 }
166 }
167 set curmess {Project loaded.}
168 } else {
169 foreach n $vl {
170 catch {unset radvar($n)}
171 }
172 while {[gets $fi curli] != -1} {
173 if [regexp {^[a-zA-Z][a-zA-Z0-9]* *=} $curli] {
174 regexp {^[a-zA-Z][a-zA-Z0-9]*} $curli thisv
175 if {[lsearch -exact $vl $thisv] >= 0} {
176 setradvar $curli
177 }
178 } else {
179 break
180 }
181 }
182 set curmess {Variables loaded.}
183 }
184 set alldone [eof $fi]
185 close $fi
186 exec rm -f /usr/tmp/ro[pid]
187 preen
188 return 1
189 }
190
191 proc save_vars {f {vl all}} { # save RIF variables
192 global curmess radvar
193 if {"$f" == {} || ! [info exists radvar]} {return 0}
194 if {"$vl" == "all"} {
195 if [catch {set fi [open $f w]} curmess] {
196 beep
197 return 0
198 }
199 puts $fi "# Rad Input File created by trad [exec date]"
200 foreach n [lsort [array names radvar]] {
201 putradvar $fi $n
202 }
203 } else {
204 if [catch {set fi [open $f a]} curmess] {
205 beep
206 return 0
207 }
208 foreach n [array names radvar] {
209 if {[lsearch -exact $vl $n] >= 0} {
210 putradvar $fi $n
211 }
212 }
213 }
214 close $fi
215 set curmess {File saved.}
216 return 1
217 }
218
219 proc newload f { # load a RIF
220 global rifname readonly
221 if [load_vars $f] {
222 set rifname [pwd]/$f
223 set readonly [expr ! [file writable $f]]
224 gotfile 1
225 return 1
226 }
227 return 0
228 }
229
230 proc newsave f { # save a RIF
231 global rifname readonly curmess
232 if {"[pwd]/$f" == "$rifname"} {
233 if $readonly {
234 beep
235 set curmess {Mode set to read only.}
236 return 0
237 }
238 } elseif {[file exists $f]} {
239 set ftyp [file type $f]
240 if { $ftyp != "file" } {
241 beep
242 set curmess "Selected file $f is a $ftyp."
243 return 0
244 }
245 if [tk_dialog .dlg {Verification} \
246 "Overwrite existing file $f?" \
247 questhead 1 {Go Ahead} {Cancel}] {
248 return 0
249 }
250 }
251 if {[file isfile $f] && ! [file writable $f] &&
252 [catch {exec chmod u+w $f} curmess]} {
253 beep
254 return 0
255 }
256 if [save_vars $f] {
257 set rifname [pwd]/$f
258 set readonly 0
259 gotfile 1
260 return 1
261 }
262 return 0
263 }
264
265 proc newnew f { # create a new RIF
266 global rifname readonly curmess radvar
267 if [file exists $f] {
268 set ftyp [file type $f]
269 if { $ftyp != "file" } {
270 beep
271 set curmess "Selected file $f is a $ftyp."
272 return 0
273 }
274 if [tk_dialog .dlg {Verification} \
275 "File $f exists -- disregard it?" \
276 questhead 1 {Yes} {Cancel}] {
277 return 0
278 }
279 }
280 if {! [chksave]} {return 0}
281 set rifname [pwd]/$f
282 set readonly 0
283 catch {unset radvar}
284 preen
285 gotfile 1
286 set curmess {Go to SCENE and enter OCTREE and/or scene file(s).}
287 return 1
288 }
289
290 proc do_file w {
291 global rifname readonly myglob curfile curpat
292 if {"$w" == "done"} {
293 cd [file dirname $rifname]
294 set myglob(rif) $curpat
295 return
296 }
297 frame $w
298 frame $w.left
299 pack $w.left -side left
300 button $w.left.load -text LOAD -width 5 \
301 -relief raised -command {newload $curfile}
302 button $w.left.save -text SAVE -width 5 -relief raised \
303 -command "newsave \$curfile; update_dir $w.right"
304 button $w.left.new -text NEW -width 5 \
305 -relief raised -command {newnew $curfile}
306 pack $w.left.load $w.left.save $w.left.new -side top -pady 15 -padx 20
307 checkbutton $w.left.ro -text "Read Only" -variable readonly \
308 -onvalue 1 -offvalue 0 -relief flat
309 pack $w.left.ro -side top -pady 15 -padx 20
310 helplink $w.left.load trad file load
311 helplink $w.left.save trad file save
312 helplink $w.left.new trad file new
313 helplink $w.left.ro trad file readonly
314 getfile -view view_txt -perm \
315 -win $w.right -glob [file dirname $rifname]/$myglob(rif)
316 set curfile [file tail $rifname]
317 }