| 1 |
# RCSid: $Id: do_file.tcl,v 2.23 2017/09/06 23:57:56 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 |
| 132 |
PGMAP PCMAP} $vn] >= 0} { |
| 133 |
puts $fi "$vn= $radvar($vn)" |
| 134 |
return |
| 135 |
} |
| 136 |
puts -nonewline $fi "$vn=" |
| 137 |
set vnl [expr [string length $vn] + 1] |
| 138 |
set pos $vnl |
| 139 |
for {set i 0} {$i < [llength $radvar($vn)]} {incr i} { |
| 140 |
set len [expr [string length [lindex $radvar($vn) $i]] + 1] |
| 141 |
if {$pos > $vnl && $pos + $len > 70} { |
| 142 |
puts -nonewline $fi "\n$vn=" |
| 143 |
set pos $vnl |
| 144 |
} |
| 145 |
puts -nonewline $fi " [lindex $radvar($vn) $i]" |
| 146 |
incr pos $len |
| 147 |
} |
| 148 |
puts $fi {} |
| 149 |
} |
| 150 |
|
| 151 |
proc load_vars {f {vl all}} { # load RIF variables |
| 152 |
global curmess radvar alldone |
| 153 |
if {"$f" == ""} {return 0} |
| 154 |
if {! [file isfile $f]} { |
| 155 |
beep |
| 156 |
set curmess "$f: no such file." |
| 157 |
return 0 |
| 158 |
} |
| 159 |
if {"$vl" == "all" && ! [chksave]} {return 0} |
| 160 |
set curmess {Please wait...} |
| 161 |
update |
| 162 |
if [catch {exec rad -n -w -e $f >& /tmp/ro[pid]}] { |
| 163 |
set curmess [exec cat /tmp/ro[pid]] |
| 164 |
exec rm -f /tmp/ro[pid] |
| 165 |
return 0 |
| 166 |
} |
| 167 |
set fi [open /tmp/ro[pid] r] |
| 168 |
if {"$vl" == "all"} { |
| 169 |
catch {unset radvar} |
| 170 |
while {[gets $fi curli] != -1} { |
| 171 |
if [regexp {^[a-zA-Z][a-zA-Z0-9]* *=} $curli] { |
| 172 |
setradvar $curli |
| 173 |
} else { |
| 174 |
break |
| 175 |
} |
| 176 |
} |
| 177 |
set curmess {Project loaded.} |
| 178 |
} else { |
| 179 |
foreach n $vl { |
| 180 |
if [regexp {[a-z][a-z]*} $n] { |
| 181 |
set radvar($n) {} |
| 182 |
} else { |
| 183 |
catch {unset radvar($n)} |
| 184 |
} |
| 185 |
} |
| 186 |
while {[gets $fi curli] != -1} { |
| 187 |
if [regexp {^[a-zA-Z][a-zA-Z0-9]* *=} $curli] { |
| 188 |
regexp {^[a-zA-Z][a-zA-Z0-9]*} $curli thisv |
| 189 |
if {[lsearch -exact $vl $thisv] >= 0} { |
| 190 |
setradvar $curli |
| 191 |
} |
| 192 |
} else { |
| 193 |
break |
| 194 |
} |
| 195 |
} |
| 196 |
set curmess {Variables loaded.} |
| 197 |
} |
| 198 |
set alldone [eof $fi] |
| 199 |
close $fi |
| 200 |
exec rm -f /tmp/ro[pid] |
| 201 |
preen |
| 202 |
return 1 |
| 203 |
} |
| 204 |
|
| 205 |
proc save_vars {f {vl all}} { # save RIF variables |
| 206 |
global curmess radvar |
| 207 |
if {"$f" == {} || ! [info exists radvar]} {return 0} |
| 208 |
if {"$vl" == "all"} { |
| 209 |
if [catch {set fi [open $f w]} curmess] { |
| 210 |
beep |
| 211 |
return 0 |
| 212 |
} |
| 213 |
puts $fi "# Rad Input File created by trad [exec date]" |
| 214 |
foreach n [lsort [array names radvar]] { |
| 215 |
putradvar $fi $n |
| 216 |
} |
| 217 |
} else { |
| 218 |
if [catch {set fi [open $f a]} curmess] { |
| 219 |
beep |
| 220 |
return 0 |
| 221 |
} |
| 222 |
foreach n [array names radvar] { |
| 223 |
if {[lsearch -exact $vl $n] >= 0} { |
| 224 |
putradvar $fi $n |
| 225 |
} |
| 226 |
} |
| 227 |
} |
| 228 |
close $fi |
| 229 |
set curmess {File saved.} |
| 230 |
return 1 |
| 231 |
} |
| 232 |
|
| 233 |
proc newload f { # load a RIF |
| 234 |
global rifname readonly |
| 235 |
if [load_vars $f] { |
| 236 |
set rifname [pwd]/$f |
| 237 |
set readonly [expr ! [file writable $f]] |
| 238 |
gotfile 1 |
| 239 |
return 1 |
| 240 |
} |
| 241 |
return 0 |
| 242 |
} |
| 243 |
|
| 244 |
proc newsave f { # save a RIF |
| 245 |
global rifname readonly curmess |
| 246 |
if {"[pwd]/$f" == "$rifname"} { |
| 247 |
if $readonly { |
| 248 |
beep |
| 249 |
set curmess {Mode set to read only.} |
| 250 |
return 0 |
| 251 |
} |
| 252 |
} elseif {[file exists $f]} { |
| 253 |
set ftyp [file type $f] |
| 254 |
if { $ftyp != "file" } { |
| 255 |
beep |
| 256 |
set curmess "Selected file $f is a $ftyp." |
| 257 |
return 0 |
| 258 |
} |
| 259 |
if [tk_dialog .dlg {Verification} \ |
| 260 |
"Overwrite existing file $f?" \ |
| 261 |
questhead 1 {Go Ahead} {Cancel}] { |
| 262 |
return 0 |
| 263 |
} |
| 264 |
} |
| 265 |
if {[file isfile $f] && ! [file writable $f] && |
| 266 |
[catch {exec chmod u+w $f} curmess]} { |
| 267 |
beep |
| 268 |
return 0 |
| 269 |
} |
| 270 |
if [save_vars $f] { |
| 271 |
set rifname [pwd]/$f |
| 272 |
set readonly 0 |
| 273 |
gotfile 1 |
| 274 |
return 1 |
| 275 |
} |
| 276 |
return 0 |
| 277 |
} |
| 278 |
|
| 279 |
proc newnew f { # create a new RIF |
| 280 |
global rifname readonly curmess radvar |
| 281 |
if [file exists $f] { |
| 282 |
set ftyp [file type $f] |
| 283 |
if { $ftyp != "file" } { |
| 284 |
beep |
| 285 |
set curmess "Selected file $f is a $ftyp." |
| 286 |
return 0 |
| 287 |
} |
| 288 |
if [tk_dialog .dlg {Verification} \ |
| 289 |
"File $f exists -- disregard it?" \ |
| 290 |
questhead 1 {Yes} {Cancel}] { |
| 291 |
return 0 |
| 292 |
} |
| 293 |
} |
| 294 |
if {! [chksave]} {return 0} |
| 295 |
set rifname [pwd]/$f |
| 296 |
set readonly 0 |
| 297 |
catch {unset radvar} |
| 298 |
preen |
| 299 |
gotfile 1 |
| 300 |
set curmess {Go to SCENE and enter OCTREE and/or scene file(s).} |
| 301 |
return 1 |
| 302 |
} |
| 303 |
|
| 304 |
proc do_file w { |
| 305 |
global rifname readonly myglob curfile curpat |
| 306 |
if {"$w" == "done"} { |
| 307 |
cd [file dirname $rifname] |
| 308 |
set myglob(rif) $curpat |
| 309 |
return |
| 310 |
} |
| 311 |
frame $w |
| 312 |
frame $w.left |
| 313 |
pack $w.left -side left |
| 314 |
button $w.left.load -text LOAD -width 5 \ |
| 315 |
-relief raised -command {newload $curfile} |
| 316 |
button $w.left.save -text SAVE -width 5 -relief raised \ |
| 317 |
-command "newsave \$curfile; update_dir $w.right" |
| 318 |
button $w.left.new -text NEW -width 5 \ |
| 319 |
-relief raised -command {newnew $curfile} |
| 320 |
pack $w.left.load $w.left.save $w.left.new -side top -pady 15 -padx 20 |
| 321 |
checkbutton $w.left.ro -text "Read Only" -variable readonly \ |
| 322 |
-onvalue 1 -offvalue 0 -relief flat |
| 323 |
pack $w.left.ro -side top -pady 15 -padx 20 |
| 324 |
helplink $w.left.load trad file load |
| 325 |
helplink $w.left.save trad file save |
| 326 |
helplink $w.left.new trad file new |
| 327 |
helplink $w.left.ro trad file readonly |
| 328 |
getfile -view view_txt -perm \ |
| 329 |
-win $w.right -glob [file dirname $rifname]/$myglob(rif) |
| 330 |
set curfile [file tail $rifname] |
| 331 |
} |
