| 1 | greg | 2.9 | # RCSid: $Id: do_results.tcl,v 2.8 2008/11/10 19:08:19 greg Exp $ | 
| 2 | greg | 2.1 | # | 
| 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 | greg | 2.9 | set conv(TIFF-Luv,nam)  "TIFF LogLuv" | 
| 13 |  |  | set conv(TIFF-Luv,com)  "ra_tiff -L %s %s" | 
| 14 |  |  | set conv(TIFF-Luv,suf)  .tif | 
| 15 | greg | 2.1 | set conv(GIF-bw,nam)    "GIF B&W" | 
| 16 |  |  | set conv(GIF-bw,com)    "ra_gif -b %s %s" | 
| 17 |  |  | set conv(GIF-bw,suf)    .gif | 
| 18 |  |  | set conv(GIF-8,nam)     "GIF" | 
| 19 |  |  | set conv(GIF-8,com)     "ra_gif -n 10 -d %s %s" | 
| 20 |  |  | set conv(GIF-8,suf)     .gif | 
| 21 |  |  | set conv(PPM-bin,nam)   "PPM (binary)" | 
| 22 |  |  | set conv(PPM-bin,com)   "ra_ppm %s %s" | 
| 23 |  |  | set conv(PPM-bin,suf)   .ppm | 
| 24 |  |  | set conv(PPM-asc,nam)   "PPM (ASCII)" | 
| 25 |  |  | set conv(PPM-asc,com)   "ra_ppm -a %s %s" | 
| 26 |  |  | set conv(PPM-asc,suf)   .ppm | 
| 27 | greg | 2.9 | set conv(BMP-bw,nam)    "BMP B&W" | 
| 28 |  |  | set conv(BMP-bw,com)    "ra_bmp -b %s %s" | 
| 29 |  |  | set conv(BMP-bw,suf)    .bmp | 
| 30 |  |  | set conv(BMP-clr,nam)   "BMP Color" | 
| 31 |  |  | set conv(BMP-clr,com)   "ra_bmp %s %s" | 
| 32 |  |  | set conv(BMP-clr,suf)   .bmp | 
| 33 | greg | 2.1 | set conv(PICT,nam)      "PICT 32-bit" | 
| 34 |  |  | set conv(PICT,com)      "ra_pict -g 1.8 %s %s" | 
| 35 |  |  | set conv(PICT,suf)      .pict | 
| 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.9 | set conv(types) {GIF-bw GIF-8 PICT PS-bw PS-clr BMP-bw BMP-clr PPM-asc\ | 
| 55 |  |  | PPM-bin 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.8 | } elseif {[file isfile $radvar(PICTURE)_[lindex $vw 0].hdr]} { | 
| 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 | greg | 2.8 | testappend sl $radvar(PICTURE)_[$fvwbox get $i].hdr | 
| 106 | greg | 2.1 | if {$getall && $rawfroot != $radvar(PICTURE)} { | 
| 107 | greg | 2.8 | testappend sl ${rawfroot}_[$fvwbox get $i].hdr | 
| 108 | greg | 2.1 | } | 
| 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 | greg | 2.8 | set p $radvar(PICTURE)_$vw.hdr | 
| 155 | greg | 2.1 | 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 | greg | 2.8 | set p $radvar(PICTURE)_[$fvwbox get $i].hdr | 
| 170 | greg | 2.1 | 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 |  |  | } |