ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/util/do_file.tcl
Revision: 2.23
Committed: Wed Sep 6 23:57:56 2017 UTC (6 years, 7 months ago) by greg
Content type: application/x-tcl
Branch: MAIN
Changes since 2.22: +6 -0 lines
Log Message:
Fixed issue with trad introduced in last change

File Contents

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