ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/util/do_results.tcl
Revision: 2.1
Committed: Wed Sep 13 14:52:19 1995 UTC (28 years, 7 months ago) by greg
Content type: application/x-tcl
Branch: MAIN
Log Message:
Initial revision

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