
# Hardcopy stuff.
#
# Copyright (c) 1995 ICEM CFD Engineering
# Author:  Wayne A. Christopher, wayne@icemcfd.com
#          ICEM CFD Engineering, Berkeley, California

proc file_hardcopy {{top .v} {sub .v.view} {startcmd ""} {endcmd ""}} {
    global hardcopy bindir host_vendor has_fromppm is_win
    
    set hardcopy(startcmd_current) $startcmd
    set hardcopy(endcmd_current) $endcmd
    set hardcopy(top_current) $top
    set hardcopy(sub_current) $sub
    
    set has_fromppm [expr {[glob -nocomplain $bindir/fromppm*] != ""}]
    
    set buts [list [list Write gui_hardcopy_print] dismiss]
    set d [form_init .hardcopy "Hardcopy" "" $buts]
    if {$d != ""} {
	form_frame $d.fr sunken 2 {0 0}; set d $d.fr
	
	form_frame $d.out flat 0 {10 0 -cols -}
        form_label $d.out.l "Output prefix" {10 0 -cols 3}
        futil_fileentry $d.out.f hardcopy(outfile) [pwd] {10 3 -cols 2}
        form_checkbutton $d.gen "Generate new output file names" \
            hardcopy(generate_new) {15 0 -cols -}
	
        form_label $d.forml "Image format:" {20 0 -cols 3}
        form_frame $d.formf flat 0 {21 1 -cols 5}
        form_radiobutton $d.formf.p PostScript hardcopy(format) ps {0 0 -cols 3}
        form_radiobutton $d.formf.ppm PPM hardcopy(format) ppm {5 0 -cols 2}
        form_radiobutton $d.formf.x X11 hardcopy(format) x {10 0 -cols 2}
        form_radiobutton $d.formf.t Tiff hardcopy(format) tiff {15 0 -cols 2}
        form_radiobutton $d.formf.gif GIF hardcopy(format) gif {20 0 -cols 2}
        form_radiobutton $d.formf.jpg JPEG hardcopy(format) jpeg {25 0 -cols 2}
        form_radiobutton $d.formf.rgb RGB hardcopy(format) rgb {30 0 -cols 2} \
	    has_fromppm
        if $is_win {
            form_radiobutton $d.formf.win "Windows printer" hardcopy(format) \
                win {40 0 -cols 4}
            form_button $d.formf.windrp Params hardcopy_win_form {40 4} \
                {{hardcopy(format) win}}
        }
        form_radiobutton $d.formf.vrml VRML hardcopy(format) vrml {45 0 -cols 2}
	
        form_colwidth $d.formf 0 2 M

        form_radiobutton $d.formf.pscr "From screen" hardcopy(ps_direct) 0 \
            {1 1 -cols 3} {{hardcopy(format) ps}}
        form_radiobutton $d.formf.psdr "Full resolution" hardcopy(ps_direct) 1 \
            {2 1 -cols 3} {{hardcopy(format) ps}}
        form_button $d.formf.psdrp Params hardcopy_ps_form {2 4} \
            {{hardcopy(format) ps} hardcopy(ps_direct)}

        form_label $d.formf.jpg_ql "Quality" {26 1 -cols 2} \
            {{hardcopy(format) jpeg}}
        form_entry $d.formf.jpg_q hardcopy(jpeg_quality) float {26 3} \
                 {{hardcopy(format) jpeg}}
            $d.formf.jpg_q configure -width 3
	
	set not_ps {{hardcopy(format) !ps}}
        form_checkbutton $d.invert "Invert black and white" hardcopy(invert) \
            {100 0 -cols -} $not_ps
        form_checkbutton $d.rot "Landscape mode" hardcopy(landscape) \
            {101 0 -cols -} $not_ps
        form_label $d.scalel "Scale factor:" {102 0 -cols 3} $not_ps
        form_entry $d.scale hardcopy(scale) float {102 3} $not_ps
           $d.scale configure -width 4
	
	form_finish bot
    }
}

proc hardcopy_ps_form {} {
    global hardcopy
    
    hardcopy_defaults
    
    set d [form_init .hardcopy_ps "PostScript Options"]
    if {$d != ""} {
	form_frame $d.fr sunken 2 {0 0}; set d $d.fr
	
	form_label $d.typel "Type" {0 0}
	form_radiobutton $d.typep "PS" hardcopy(ps_type) "" {0 1}
	form_radiobutton $d.typee "EPS" hardcopy(ps_type) "_eps" {1 1}
	
	form_label $d.model "Mode" {5 0}
	form_radiobutton $d.modec "Color" hardcopy(ps_color) color {5 1}
	form_radiobutton $d.modeg "Gray" hardcopy(ps_color) gray {6 1}
	form_radiobutton $d.modem "Mono" hardcopy(ps_color) mono {7 1}
	
	form_checkbutton $d.frame "Include frame" hardcopy(ps_frame) {10 0 -cols 2}
	form_label $d.titlel "Title (top of page)" {15 0 -cols 2}
	form_entry $d.title hardcopy(ps_title) string {16 0 -cols 2}
	form_label $d.labell "Label (bottom of page)" {17 0 -cols 2}
	form_entry $d.label hardcopy(ps_label) string {18 0 -cols 2}
	
	form_checkbutton $d.print "Send to printer" hardcopy(send_to_printer) \
	    {20 0 -cols 2} {{hardcopy(format) ps}}
	
	form_finish -0-0
    }
}

proc hardcopy_win_form {} {
    global hardcopy
    
    hardcopy_defaults
    
    set d [form_init .hardcopy_win "Windows Printer Options"]
    if {$d != ""} {
	form_frame $d.fr sunken 2 {0 0}; set d $d.fr
	form_label $d.model "Mode" {5 0}
	form_radiobutton $d.modec "Color" hardcopy(ps_color) color {5 1}
	form_radiobutton $d.modeg "Gray" hardcopy(ps_color) gray {6 1}
	form_radiobutton $d.modem "Mono" hardcopy(ps_color) mono {7 1}
	
	form_checkbutton $d.frame "Include frame" hardcopy(ps_frame) {10 0 -cols 2}
	form_label $d.titlel "Title (top of page)" {15 0 -cols 2}
	form_entry $d.title hardcopy(ps_title) string {16 0 -cols 2}
	form_label $d.labell "Label (bottom of page)" {17 0 -cols 2}
	form_entry $d.label hardcopy(ps_label) string {18 0 -cols 2}
	
	form_finish -0-0
    }
}

proc hardcopy_defaults {} {
    global hardcopy job_title tool_name version whoami job_name
    
    if {$hardcopy(ps_title) == "--default--"} {
	if {$job_title == ""} {
	    set hardcopy(ps_title) $job_name
	} else {
	    set hardcopy(ps_title) $job_title
	}
    }
    if {($hardcopy(ps_label) == "--default--") || \
	    [string match "$tool_name $version *" $hardcopy(ps_label)]} {
	set hardcopy(ps_label) "$tool_name $version; [cmd_whoami]@[cmd_uname_n]; [cmd_date]"
    }
}

proc hardcopy_create {} {
    global hardcopy bindir job_name is_win
    
    foreach v {top sub startcmd endcmd} { set $v $hardcopy(${v}_current) }
    hardcopy_defaults
    if {$startcmd != ""} { eval $startcmd }

    set after ""; set after_o ""
    set directps 0
    set do_print 0
    set suff2 not_used
    switch $hardcopy(format) {
	    ps {
	        set cmd [list $bindir/pnmtops]
	        set suff ps
	        set directps $hardcopy(ps_direct)
	        set do_print $hardcopy(send_to_printer)
	    }
	    tiff {
	        set cmd [list $bindir/pnmtotiff]
	        set suff tiff
	    }
	    x {
	        set cmd [list $bindir/pnmtoxwd]
	        set suff xwd
	    }
	    gif {
	        set cmd [list $bindir/ppmtogif]
	        set suff gif
	    }
	    jpeg {
	        set suff ppm
	        if $is_win {
	            set cmd ""
                set after [list $bindir/cjpeg -quality $hardcopy(jpeg_quality)]
	        } else {
	            set cmd [list cat]
	            set after_o [list $bindir/cjpeg -quality $hardcopy(jpeg_quality)]
	        }
	        set suff2 jpg
	    }
	    ppm {
		    if $is_win {
		        set cmd ""
		    } else {
	            set cmd [list cat]
	        }
	        set suff ppm
	    }
	    rgb {
	        if $is_win {
	            set cmd ""
	        } else {
	            set cmd [list cat]
	        }
	        set suff ppm
	        set after $bindir/fromppm
	        set suff2 rgb
	    }
	    win {
	        $sub mswin_print "$job_name" "$hardcopy(ps_title)" "$hardcopy(ps_label)" color $hardcopy(ps_frame) $hardcopy(landscape) 1
	        if {$endcmd != ""} { eval $endcmd }
	        return ""
	    }
	    vrml {
	        set suff vrml
	    }
	    default {
	        error "Unknown output format $hardcopy(format)"
	    }
    }
    
    set pref $hardcopy(outfile)
    if $hardcopy(generate_new) {
	    for {set i 1} 1 {incr i} {
	        set file $pref[format %03d $i].$suff
	        set file2 $pref[format %03d $i].$suff2
	        if {![file exists $file] && ![file exists $file2]} break
	    }
	    mess "Output file is $file ...\n"
    } else {
	    set file $pref.$suff
	    set file2 $pref.$suff2
    }
    if {$hardcopy(format) == "vrml"} {
	    mess "Writing file $file... "
	    $sub write_vrml $file
	    if {$endcmd != ""} { eval $endcmd }
	    mess "done.\n"
	    return $file
    }

    if {($hardcopy(format) == "gif") || ($hardcopy(format) == "x") || ($hardcopy(format) == "tiff")} {
	    set cmd [concat [list $bindir/ppmquant -fs 256 |] $cmd]
    }
    if {$hardcopy(scale) != 1} {
        if {$cmd != ""} {
	        set cmd [concat [list $bindir/pnmscale $hardcopy(scale) |] $cmd]
	    }
    }
    
    set orient portrait
    if $hardcopy(landscape) {
	    set orient landscape
    }

    if $directps {
	    mess "Writing PostScript to file $file ...\n"
	
	    switch $hardcopy(ps_color) {
	        color {
		        mess "Saving color$hardcopy(ps_type) postscript image to file \"$file\" ...\n"
		        $sub postscript $file $hardcopy(ps_title) $hardcopy(ps_label) color$hardcopy(ps_type) $hardcopy(ps_frame)
	        }
	        gray {
		        mess "Saving gray$hardcopy(ps_type) postscript image to file \"$file\" ...\n"
		        cmap_bnw $sub 1
		        $sub postscript $file $hardcopy(ps_title) $hardcopy(ps_label) gray$hardcopy(ps_type) $hardcopy(ps_frame)
		        cmap_bnw $sub 0
	        }
	        mono {
		        mess "Saving mono$hardcopy(ps_type) postscript image to file \"$file\" ...\n"
		        cmap_bnw $sub 1
		        $sub postscript $file $hardcopy(ps_title) $hardcopy(ps_label) mono$hardcopy(ps_type) $hardcopy(ps_frame)
		        cmap_bnw $sub 0
	        }
	    }
	    mess "Done writing output.\n"
     
	    if $do_print {
	        set cmd [get_print_cmd]
	        if {$cmd != ""} {
	            mess "Sending to printer...\n"
	            eval exec $cmd $file
	            mess "Done.\n"
	        } else {
	            mess "Unable to send file $file to printer.\n"
	            mess "Do not know print command.\n"
	        }
	    }
	    if {$endcmd != ""} { eval $endcmd }
	    return $file
    }

    set errf [directory]/plot_output.tmp

    if {$cmd != ""} {
        lappend cmd > $file 2> $errf
    }
  
    if {($hardcopy(format) == "jpeg" || $hardcopy(format) == "ppm" || $hardcopy(format) == "rgb") && $is_win} {
        set fp [open $file w]
    } else {
        mess "Running | $cmd\n"
        set fp [open [concat | $cmd] w]
    }
    fconfigure $fp -translation binary
    raise $top
    
    $sub redraw; $sub redraw; update
    busy 1
    mess "Capturing screen image ...\n"

    $sub write_ppm $fp $orient $hardcopy(invert) 0 0 0 0
    catch {flush $fp}
    if [catch {close $fp} res] { mess "$res\n" red }
   
    if [file exists $errf] {
        set fp [open $errf r]
        mess [read $fp]
        close $fp
        ic_rm $errf
    }   
    set outfile $file

    if {$after != ""} {
	    set cmd [concat $after [list $file $file2]]
	    mess "Running $cmd\n"
	    if [catch {eval exec $cmd} res] {
	        mess $res red
	    }
        set outfile $file2
    }
    if {$after_o != ""} {
        set cmd [concat $after_o [list $file > $file2]]
        mess "Running $cmd\n"
        if [catch {eval exec $cmd} res] {
            mess $res red
        }
        set outfile $file2
    }
    if {$hardcopy(format) == "jpeg"} {
        if [file exists $file] { ic_rm $file }
    }
    mess "Done writing output file $outfile\n"
    busy 0
    
    if {[file pathtype $outfile] == "relative"} {
       set file [directory plots]/$outfile
    } else {
       set file $outfile
    }
    if {$endcmd != ""} { eval $endcmd }
    if $do_print {
	    set cmd [get_print_cmd]
	    if {$cmd != ""} {
	        mess "Sending to printer...\n"
	        eval exec $cmd $file
	        mess "Done.\n"
	    } else {
	        mess "Unable to send file $file to printer.\n"
	        mess "Do not know print command.\n"
	    }
    }
    return $file
}

proc get_print_cmd {} {
    set cmd [get_path lp 1]
    if {$cmd != ""} {return "$cmd" }
    set cmd [get_path lpr 1]
    if {$cmd != ""} {return "$cmd" }
    return ""
}

proc gui_hardcopy_create {arguments} {
    global hardcopy job_name job_title
    global tdv_default batch_mode
    
    if $batch_mode return
    set hardcopy(top_current) [winfo toplevel $tdv_default]
    set hardcopy(sub_current) $tdv_default
    set hardcopy(startcmd_current) ""
    set hardcopy(endcmd_current) ""
    set job_name unknown
    set job_title unknown
    
    foreach {n v} $arguments { set hardcopy($n) $v }
    hardcopy_create
}

proc gui_hardcopy_print {} {
     global hardcopy     
     set values ""
     foreach n {startcmd_current endcmd_current top_current sub_current \
                format outfile invert landscape generate_new \
                scale jpeg_quality mpegfile mpegpat ps_direct ps_type \
                ps_color ps_frame ps_title ps_label send_to_printer} {
        lappend values $n "$hardcopy($n)"
     }
     eval ic_print $values
}

proc create_screenshot {outfile} {
    global batch_mode env tdv_default is_win

    if $batch_mode return
    regsub -all \\\\ $outfile "/" outfile
    set tmp_file [cmd_tempfile screen]
    set file $tmp_file
    set fp [open $file w]
    fconfigure $fp -translation binary
    $tdv_default write_ppm $fp portrait 0 0 0 0 0
    catch { flush $fp }; close $fp
    set exe "$env(ICEM_ACN)/bin/cjpeg"
    if $is_win { append $exe .exe }
    exec "$exe" -quality 100 $file $outfile
    ic_rm "$file"
    mess "$outfile created\n"
}

