ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/util/do_file.tcl
Revision: 2.12
Committed: Tue Oct 17 21:28:20 1995 UTC (28 years, 6 months ago) by greg
Content type: application/x-tcl
Branch: MAIN
Changes since 2.11: +14 -2 lines
Log Message:
took greater caution with files that might not be regular files

File Contents

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