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

File Contents

# User Rev Content
1 greg 2.1 # SCCSid "$SunId$ LBL"
2     #
3     # Results screen for trad
4     #
5    
6     set conv(TIFF-bw,nam) "TIFF B&W"
7     set conv(TIFF-bw,com) "ra_tiff -b %s %s"
8     set conv(TIFF-bw,suf) .tif
9     set conv(TIFF-24,nam) "TIFF 24-bit"
10     set conv(TIFF-24,com) "ra_tiff %s %s"
11     set conv(TIFF-24,suf) .tif
12     set conv(GIF-bw,nam) "GIF B&W"
13     set conv(GIF-bw,com) "ra_gif -b %s %s"
14     set conv(GIF-bw,suf) .gif
15     set conv(GIF-8,nam) "GIF"
16     set conv(GIF-8,com) "ra_gif -n 10 -d %s %s"
17     set conv(GIF-8,suf) .gif
18     set conv(PPM-bin,nam) "PPM (binary)"
19     set conv(PPM-bin,com) "ra_ppm %s %s"
20     set conv(PPM-bin,suf) .ppm
21     set conv(PPM-asc,nam) "PPM (ASCII)"
22     set conv(PPM-asc,com) "ra_ppm -a %s %s"
23     set conv(PPM-asc,suf) .ppm
24     set conv(PICT,nam) "PICT 32-bit"
25     set conv(PICT,com) "ra_pict -g 1.8 %s %s"
26     set conv(PICT,suf) .pict
27     set conv(ras-bw,nam) "Sun B&W"
28     set conv(ras-bw,com) "ra_pr -b %s %s"
29     set conv(ras-bw,suf) .ras
30     set conv(ras-8,nam) "Sun 8-bit"
31     set conv(ras-8,com) "ra_pr %s %s"
32     set conv(ras-8,suf) .ras
33     set conv(ras-24,nam) "Sun 24-bit"
34     set conv(ras-24,com) "ra_pr24 %s %s"
35     set conv(ras-24,suf) .ras
36 greg 2.4 set conv(PS-bw,nam) "PostScript B&W"
37 greg 2.5 set conv(PS-bw,com) "ra_ps -b -C %s %s"
38 greg 2.4 set conv(PS-bw,suf) .ps
39     set conv(PS-clr,nam) "PostScript Color"
40 greg 2.5 set conv(PS-clr,com) "ra_ps -c -C %s %s"
41 greg 2.4 set conv(PS-clr,suf) .ps
42 greg 2.1 set conv(tga-bw,nam) "Targa B&W"
43     set conv(tga-bw,com) "ra_t8 -b %s %s"
44     set conv(tga-bw,suf) .tga
45     set conv(tga-8,nam) "Targa 8-bit"
46     set conv(tga-8,com) "ra_t8 -n 10 -d %s %s"
47     set conv(tga-8,suf) .tga
48     set conv(tga-16,nam) "Targa 16-bit"
49     set conv(tga-16,com) "ra_t16 -2 %s %s"
50     set conv(tga-16,suf) .tga
51     set conv(tga-24,nam) "Targa 24-bit"
52     set conv(tga-24,com) "ra_t16 -3 %s %s"
53     set conv(tga-24,suf) .tga
54 greg 2.4 set conv(types) {GIF-bw GIF-8 PICT PS-bw PS-clr PPM-asc PPM-bin ras-bw ras-8\
55     ras-24 tga-bw tga-8 tga-16 tga-24 TIFF-bw TIFF-24}
56 greg 2.1 set conv(typ) tga-24
57    
58     proc testappend {flst tf} { # test if tf exists and append to flst if so
59     upvar $flst mylist
60 greg 2.6 if [file isfile $tf] {
61 greg 2.1 lappend mylist $tf
62     }
63     }
64    
65     proc list_views {} { # List finished and unfinished pictures
66     global radvar fvwbox ufvwbox alldone rawfroot
67     set fpics {}
68     set ufpics {}
69     foreach vw $radvar(view) {
70 greg 2.6 if [file isfile ${rawfroot}_[lindex $vw 0].unf] {
71 greg 2.1 lappend ufpics [lindex $vw 0]
72 greg 2.6 } elseif {[file isfile $radvar(PICTURE)_[lindex $vw 0].pic]} {
73 greg 2.1 lappend fpics [lindex $vw 0]
74     }
75     }
76     $fvwbox delete 0 end
77     eval $fvwbox insert end $fpics
78     $ufvwbox delete 0 end
79     eval $ufvwbox insert end $ufpics
80     set alldone [expr [llength $fpics] == [llength $radvar(view)]]
81     }
82    
83     proc delpic {} { # Delete selected pictures
84     global curmess
85     set selected_pics [get_selpics 1]
86 greg 2.2 if {$selected_pics == {}} {
87 greg 2.1 set curmess "No pictures selected."
88     return
89     }
90     if [tk_dialog .dlg {Verification} \
91     "Really delete file(s) $selected_pics?" \
92     questhead 0 {Delete} {Cancel}] {
93     return
94     }
95     if {! [catch {eval exec rm $selected_pics < /dev/null} curmess]} {
96     set curmess "Deleted [llength $selected_pics] file(s)."
97     }
98     list_views
99     }
100    
101     proc get_selpics {{getall 0}} { # return selected pictures
102     global fvwbox ufvwbox radvar rawfroot
103     set sl {}
104     foreach i [$fvwbox curselection] {
105     testappend sl $radvar(PICTURE)_[$fvwbox get $i].pic
106     if {$getall && $rawfroot != $radvar(PICTURE)} {
107     testappend sl ${rawfroot}_[$fvwbox get $i].pic
108     }
109     if {$getall && $radvar(ZFILE) != {}} {
110     testappend sl $radvar(ZFILE)_[$fvwbox get $i].zbf
111     }
112     }
113     foreach i [$ufvwbox curselection] {
114     testappend sl ${rawfroot}_[$ufvwbox get $i].unf
115     if {$getall && $radvar(ZFILE) != {}} {
116     testappend sl $radvar(ZFILE)_[$ufvwbox get $i].zbf
117     }
118     }
119     return $sl
120     }
121    
122     proc dsppic {} { # Display selected pictures
123     global curmess dispcom radvar
124     set selected_pics [get_selpics]
125 greg 2.2 if {$selected_pics == {}} {
126 greg 2.1 set curmess "No pictures selected."
127     return
128     }
129 greg 2.2 if {$radvar(EXPOSURE) == {}} {
130 greg 2.1 set ev 0
131     } else {
132     if [regexp {^[+-]} $radvar(EXPOSURE)] {
133 greg 2.3 set ev [expr {round($radvar(EXPOSURE))}]
134 greg 2.1 } else {
135 greg 2.3 set ev [expr {round(log($radvar(EXPOSURE))/log(2))}]
136 greg 2.1 }
137     }
138     foreach p $selected_pics {
139 greg 2.2 if {[string match *.unf $p] ||
140 greg 2.3 $radvar(PICTURE) == $radvar(RAWFILE)} {
141 greg 2.1 set dc [format $dispcom $ev $p]
142     } else {
143     set dc [format $dispcom 0 $p]
144     }
145     catch {eval exec $dc} curmess
146     }
147     }
148    
149     proc cnvpic {} { # Convert selected pictures
150     global curmess radvar conv convdest fvwbox
151     set curmess "No finished pictures selected."
152     foreach i [$fvwbox curselection] {
153     set vw [$fvwbox get $i]
154     set p $radvar(PICTURE)_$vw.pic
155     set df [format $convdest $vw]
156     set curmess "Converting $p to $df..."
157     update
158     set cc [format $conv($conv(typ),com) $p $df]
159     if {! [catch {eval exec $cc} curmess]} {
160     set curmess "Done."
161     }
162     }
163     }
164    
165     proc prtpic {} { # Print selected pictures
166     global curmess prntcom radvar fvwbox
167     set curmess "No finished pictures selected."
168     foreach i [$fvwbox curselection] {
169     set p $radvar(PICTURE)_[$fvwbox get $i].pic
170     set curmess "Printing $p..."
171     update
172     set pc [format $prntcom $p]
173     if {! [catch {eval exec $pc} curmess]} {
174     set curmess "Done."
175     }
176     }
177     }
178    
179     proc do_results w { # Results screen
180     global radvar curmess fvwbox ufvwbox dispcom prntcom conv \
181     rawfroot convdest
182     if {"$w" == "done"} {
183     unset fvwbox ufvwbox convdest rawfroot
184     return
185     }
186     frame $w
187     # Finished view box
188     label $w.vvl -text "Finished views"
189     place $w.vvl -relx .0714 -rely .0610
190     frame $w.vnl
191     scrollbar $w.vnl.sb -relief sunken -command "$w.vnl.lb yview"
192     listbox $w.vnl.lb -relief sunken -yscroll "$w.vnl.sb set" \
193     -selectmode extended
194     pack $w.vnl.sb -side right -fill y
195     pack $w.vnl.lb -side left -expand yes -fill both
196     place $w.vnl -relwidth .2143 -relheight .4268 -relx .0714 -rely .1220
197     set fvwbox $w.vnl.lb
198     helplink $w.vnl.lb trad results finished
199     # Unfinished view box
200     label $w.uvvl -text "Unfinished views"
201     place $w.uvvl -relx .7143 -rely .0610
202     frame $w.uvnl
203     scrollbar $w.uvnl.sb -relief sunken -command "$w.uvnl.lb yview"
204     listbox $w.uvnl.lb -relief sunken -yscroll "$w.uvnl.sb set" \
205     -selectmode extended
206     pack $w.uvnl.sb -side right -fill y
207     pack $w.uvnl.lb -side left -expand yes -fill both
208     place $w.uvnl -relwidth .2143 -relheight .4268 -relx .7143 -rely .1220
209     set ufvwbox $w.uvnl.lb
210     helplink $w.uvnl.lb trad results unfinished
211     # Rescan button
212     button $w.rsb -text Rescan -relief raised -command list_views
213     place $w.rsb -relwidth .1071 -relheight .0610 -relx .4464 -rely .2439
214     helplink $w.rsb trad results rescan
215     # Delete button
216     button $w.del -text Delete -relief raised -command delpic
217     place $w.del -relwidth .1071 -relheight .0610 -relx .4464 -rely .3659
218     helplink $w.del trad results delete
219     # Display picture(s)
220     if {! [info exists dispcom]} {
221     set dispcom "ximage -e %+d %s >& /dev/null &"
222     }
223     button $w.dpyb -text Display -relief raised -command dsppic
224     place $w.dpyb -relwidth .1071 -relheight .0610 -relx .0714 -rely .6098
225     helplink $w.dpyb trad results display
226     label $w.dpycl -text Command:
227     place $w.dpycl -relx .2143 -rely .6098
228     entry $w.dpyce -textvariable dispcom -relief sunken
229     place $w.dpyce -relwidth .5714 -relheight .0610 -relx .3571 -rely .6098
230     helplink $w.dpyce trad results dispcommand
231     # Convert picture(s)
232     button $w.cnvb -text Convert -relief raised -command cnvpic
233     place $w.cnvb -relwidth .1071 -relheight .0610 -relx .0714 -rely .7317
234     helplink $w.cnvb trad results convert
235     menubutton $w.typb -text $conv($conv(typ),nam) -relief raised \
236     -menu $w.typb.m
237 greg 2.4 place $w.typb -relwidth .1986 -relheight .0610 -relx .2143 -rely .7317
238 greg 2.1 helplink $w.typb trad results convtype
239     menu $w.typb.m
240     foreach t $conv(types) {
241     $w.typb.m add radiobutton -variable conv(typ) -value $t \
242     -label $conv($t,nam) \
243     -command "$w.typb configure -text \"$conv($t,nam)\"
244     set convdest $radvar(PICTURE)_%s$conv($t,suf)"
245     }
246     label $w.fil -text File:
247 greg 2.4 place $w.fil -relx .4486 -rely .7317
248 greg 2.1 set convdest $radvar(PICTURE)_%s$conv($conv(typ),suf)
249     entry $w.file -textvariable convdest -relief sunken
250 greg 2.4 place $w.file -relwidth .4086 -relheight .0610 -relx .5200 -rely .7317
251 greg 2.1 helplink $w.file trad results convfile
252     # Print picture(s)
253     button $w.prtb -text Print -relief raised -command prtpic
254     place $w.prtb -relwidth .1071 -relheight .0610 -relx .0714 -rely .8537
255     helplink $w.prtb trad results print
256     label $w.prtl -text Command:
257     place $w.prtl -relx .2143 -rely .8537
258     if {! [info exists prntcom]} {
259     set prntcom "ra_ps %s | lpr"
260     }
261     entry $w.prte -textvariable prntcom -relief sunken
262     place $w.prte -relwidth .5714 -relheight .0610 -relx .3571 -rely .8537
263     helplink $w.prte trad results printcommand
264     # Fill in views
265 greg 2.2 if {$radvar(RAWFILE) != {}} {
266 greg 2.1 set rawfroot $radvar(RAWFILE)
267 greg 2.3 if {$radvar(RAWFILE) == $radvar(PICTURE)} {
268     set curmess "Warning: finished views are unfiltered"
269     }
270 greg 2.1 } else {
271     set rawfroot $radvar(PICTURE)
272     }
273     list_views
274     }