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


proc print_hardcopy {{top .v} {sub ""} {startcmd ""} {endcmd ""}
			  {options ""} {get_size_from ""}} {
    global hardcopy bindir host_vendor has_fromppm is_win tdv_last_viewer_clicked
    global p_hardcopy file_select file_hardcopy_dirname tdv_default

    # on pressing accept, want to call hardcopy_create
    
    if {$sub == ""} {
	set sub $tdv_last_viewer_clicked
	if ![winfo exists $sub] {
	    set sub $tdv_default
	    set tdv_last_viewer_clicked $tdv_default
	}
    }
    
    if {$get_size_from == ""} { set get_size_from $sub }
    
    set p_hardcopy(max_width) [ winfo width $get_size_from ]
    set p_hardcopy(max_height) [ winfo height $get_size_from ]
    
    set p_hardcopy(startcmd_current) $startcmd
    set p_hardcopy(endcmd_current) $endcmd
    set p_hardcopy(top_current) $top
    set p_hardcopy(sub_current) $get_size_from
    set p_hardcopy(send_to_printer) 1
    
    set p_hardcopy(outfile) [directory]/[file tail $p_hardcopy(outfile)]
    
    set has_fromppm [expr {[glob_fixed $bindir/fromppm*] != ""}]
    
    foreach {o v} $options {
	set old_options($o) $p_hardcopy($o)
	set p_hardcopy($o) $v
    }
    
    # print cancel reset buttons
    set buts [list [list Print "hardcopy_create p; form_done .print_options"] nl cancel nl reset nl help]
    set d [form_init .print_options "Print options" "" $buts "" 1 0 ]
    if {$d != ""} {
	if !$is_win {
	    # We should add this at some point to mswin_print
	    set d1 [form_label_frame $d.formr "Region" {0 0}]
	    
	    form_label $d1.howl "Select using" {1 0}
	    futil_menuentry_labels $d1.how p_hardcopy(region_type) \
		{list {all "Full screen"} \
		     {screen "Mouse selection"} \
		     {explicit "Pixel location"}} {1 1 -cols 2}
	    
	    set act_ex [list [list p_hardcopy(region_type) explicit] ]
	    
	    form_label $d1.xsl "Left" {6 0 -cols 1} $act_ex 
	    form_entry $d1.xs p_hardcopy(xstart) float {6 1}  $act_ex
	    
	    if { $p_hardcopy(width) == 0} {
		set p_hardcopy(width) $p_hardcopy(max_width)
	    }
	    if { $p_hardcopy(height) == 0} {
		set p_hardcopy(height) $p_hardcopy(max_height)
	    }
	    
	    form_label $d1.wl "Width" {6 2 -cols 1}  $act_ex
	    form_entry $d1.w p_hardcopy(width) float {6 3 -cols 1}  $act_ex
	    
	    form_label $d1.ysl "Bottom" {7 0 -cols 1}  $act_ex
	    form_entry $d1.ys p_hardcopy(ystart) float {7 1 -cols 1}  $act_ex
	    
	    form_label $d1.hl "Height" {7 2 -cols 1}  $act_ex
	    form_entry $d1.h p_hardcopy(height) float {7 3 -cols 1}  $act_ex
	}
	
	# print options
	set d2 [form_label_frame $d.formf "Options" {1 0 -cols 6}]
	if !$is_win {
	    set f_hardcopy(format) *.ps
	    
	    form_label $d2.howl "Type" {0 0}
	    futil_menuentry_labels $d2.how p_hardcopy(ps_direct) \
		{list {0 "From screen"} {1 "Full resolution"}} {0 1}
	    set ps_full [list [list p_hardcopy(ps_direct) 1] ]
	    
	    set f_hardcopy(ps_type) {"" "PS"}

	    form_label $d2.model "Color mode" {1 0}  $ps_full
	    futil_menuentry_labels $d2.listmod p_hardcopy(ps_color) \
		{list {color "Color"} {gray "Gray"} {mono "Mono"}} \
		{1 1} $ps_full
	} else {  
            set f_hardcopy(format) *.win
	    
	    form_label $d2.howl "Type" {0 0}
	    # This doesn't work on windows: {0 "From screen"}
	    futil_menuentry_labels $d2.how p_hardcopy(win_direct) \
		{list {1 "Full resolution"}} {0 1}
	    set win_full [list [list p_hardcopy(win_direct) 1] ]
	    
	    form_label $d2.model "Color mode" {1 0}  $win_full
	    futil_menuentry_labels $d2.listmod p_hardcopy(win_color) \
		{list {color "Color"} {gray "Gray"} {mono "Mono"}} \
		{1 1} $win_full
	    
	    form_checkbutton $d2.invert "Invert black and white" p_hardcopy(invert) \
		{0 2} 
	    form_checkbutton $d2.rot "Landscape mode" p_hardcopy(landscape) \
		{1 2} 
	    form_label $d2.scalel "Scale factor:" {2 0} 
	    form_entry $d2.scale p_hardcopy(scale) float {2 1} 
	    
        }
	form_finish bot
    }
    form_wait .print_options
    foreach o [array names old_options] { set p_hardcopy($o) $old_options($o) }
}


proc picture_option_form {{top .v} {sub ""} {startcmd ""} {endcmd ""}
			  {options ""} {get_size_from ""}} {
    global hardcopy bindir host_vendor has_fromppm is_win tdv_last_viewer_clicked
    global f_hardcopy file_select tdv_default
    
    if {$sub == ""} {
	set sub $tdv_last_viewer_clicked
	if ![winfo exists $sub] { set sub $tdv_default }
    }
    
    if {$get_size_from == ""} { set get_size_from $sub }
    
    
    set has_fromppm [expr {[glob_fixed $bindir/fromppm*] != ""}]
    # add default and help, ok
    set buts [list accept nl cancel nl reset]    
    set d [form_init .picture_options "Graphics file options" "" $buts "" 1 0 ]
    if {$d != ""} {
	#
	set d1 [form_label_frame $d.formr "Region" {0 0 -cols 6}]
	
	form_label $d1.howl "Select using" {1 0}
	set not_vrml {{f_hardcopy(format) !*.vrml}}
	futil_menuentry_labels $d1.how f_hardcopy(region_type) \
	    {list {all "Full screen"} \
		 {screen "Mouse selection"} \
		 {explicit "Pixel location"}} {1 1 -cols 2} {{f_hardcopy(format) !*.vrml}}
	
	set act_exp [list [list f_hardcopy(region_type) explicit] ]
	set act_ex [concat $act_exp {{f_hardcopy(format) !*.vrml}}]
	form_label $d1.xsl "Left" {6 0 -cols 1} $act_ex 
	form_entry $d1.xs f_hardcopy(xstart) float {6 1}  $act_ex
	
	if { $f_hardcopy(width) == 0} {
	    set f_hardcopy(width) $f_hardcopy(max_width)
	}
	if { $f_hardcopy(height) == 0} {
	    set f_hardcopy(height) $f_hardcopy(max_height)
	}
	
	form_label $d1.wl "Width" {6 2 -cols 1}  $act_ex
	form_entry $d1.w f_hardcopy(width) float {6 3 -cols 1}  $act_ex
	
	form_label $d1.ysl "Bottom" {7 0 -cols 1}  $act_ex
	form_entry $d1.ys f_hardcopy(ystart) float {7 1 -cols 1}  $act_ex
	
	form_label $d1.hl "Height" {7 2 -cols 1}  $act_ex
	form_entry $d1.h f_hardcopy(height) float {7 3 -cols 1}  $act_ex	
	set d2 [form_label_frame $d.formf "PS options" {1 0 -cols 4}]
	set d3 [form_label_frame $d.formf1 "Image options" {1 4 -cols 2}]
	# postscript options	
	set ps_act {{f_hardcopy(format) *.ps}}	
	
	#form_radiobutton $d2.pscr "From screen" f_hardcopy(ps_direct) 0 {101 0 -cols 1}  $ps_act
	#form_radiobutton $d2.psdr "Full resolution" f_hardcopy(ps_direct) 1 {102 0 -cols 1}  $ps_act
	
	form_frame $d2.opts flat 0 {103 0 -cols 6}
	
	form_label $d2.opts.resl "Resolution" {0 0} $ps_act
	set list_res {list {1 "Full resolution"} {0 "From screen"}}
	futil_menuentry_labels $d2.opts.res f_hardcopy(ps_direct) $list_res {0 1} $ps_act
	
	form_label $d2.opts.typel "Type" {1 0}  $ps_act
	set list_ps {list {"" "PS"} {_eps "EPS"}}
	futil_menuentry_labels $d2.opts.type f_hardcopy(ps_type) $list_ps {1 1} $ps_act
	
	form_label $d2.opts.model "Mode" {2 0}  $ps_act
	set list_mode {list {color "Color"} {gray "Gray"} {mono "Mono"}}
	futil_menuentry_labels $d2.opts.mode f_hardcopy(ps_color) $list_mode {2 1} $ps_act
	
	form_checkbutton $d2.opts.frame "Frame" f_hardcopy(ps_frame) {3 0} $ps_act

	form_checkbutton $d2.opts.labels "Labels" f_hardcopy(ps_labels) {3 1} $ps_act

	# end of region selecting buttons
	
	# print properties
	set dr $d3
	
	set not_ps_vrml {{f_hardcopy(format) *.gif *.ppm *.jpg *.rgb *.tiff *.xwd}}
	
	form_checkbutton $dr.invert "Invert black and white" f_hardcopy(invert) \
	    {100 0 -cols -} $not_ps_vrml
	form_checkbutton $dr.rot "Landscape mode" f_hardcopy(landscape) \
	    {101 0 -cols -} $not_ps_vrml
	form_label $dr.scalel "Scale factor:" {102 0 -cols 3} $not_ps_vrml
	form_label $dr.jpeg "JPEG Quality" {103 0 -cols 3} {{f_hardcopy(format) *.jpg}}
	form_entry $dr.scale f_hardcopy(scale) float {102 3} $not_ps_vrml
	form_entry $dr.jpeg_q f_hardcopy(jpeg_quality) float {103 3} \
	    {{f_hardcopy(format) *.jpg}}
	$dr.scale configure -width 4
	$dr.jpeg_q configure -width 4
	
	form_finish bot
    }
    form_wait .picture_options
    foreach o [array names old_options] { set f_hardcopy($o) $old_options($o) }
}

    

proc picture_file_save_extra_widgets {d} {
    global picture_file_save
    global f_hardcopy
    
    set bw 8
    
    form_button $d.optbut "Options ..." picture_option_form {}
    $d.optbut configure -width $bw
    
    # We have to do this to make these widgets line up with the ones above.
    pack $d.optbut -side right -padx 4 -anchor e
    
    return ""
}

proc file_hardcopy {{def_name ""} {top .v} {sub ""} {startcmd ""} {endcmd ""} \
			    {options ""} {get_size_from ""} } {
    global picture_file_save post_objects job_name job_version filetype_data
    global bindir app_name saving_as_version solve_id message_save_directory
    global tdv_last_viewer_clicked use_builtin_file_dialogs
    global f_hardcopy hardcopy hardcopy_auto_dirname tdv_default use_blt_graph
    
    if {$sub == ""} {
	set sub $tdv_last_viewer_clicked
	if ![winfo exists $sub] {
	    set sub $tdv_default
	    set tdv_last_viewer_clicked $tdv_default
	}
    }
    
    if {$get_size_from == ""} { set get_size_from $sub }
    
    set f_hardcopy(max_width) [ winfo width $get_size_from ]
    set f_hardcopy(max_height) [ winfo height $get_size_from ]
    
    set f_hardcopy(startcmd_current) $startcmd
    set f_hardcopy(endcmd_current) $endcmd
    set f_hardcopy(top_current) $top
    set f_hardcopy(sub_current) $get_size_from
    set f_hardcopy(send_to_printer) 0

    if {$def_name == ""} {
	set def_name $job_name/screen.[string range $f_hardcopy(format) 2 end]
    }
    
    # these are not supported and not interesting
    #{{XWD files}        {.xwd}}
    #{{RGB (IRIX) files} {.rgb}}
    
    if {[info exists use_blt_graph] && $use_blt_graph} {
        set types {
	    {{GIF files}        {.gif}}
	    {{JPEG files}       {.jpg}}
	    {{PPM files}        {.ppm}}
	    {{TIFF files}       {.tiff}}
	    {{Postscript files} {.ps}}
	}
    } else {
        set types {
	    {{GIF files}        {.gif}}
	    {{JPEG files}       {.jpg}}
	    {{PPM files}        {.ppm}}
	    {{TIFF files}       {.tiff}}
	    {{VRML scripts}     {.vrml}}
	    {{Postscript files} {.ps}}
	}
    }
    
    if {$f_hardcopy(format) == ".*"} {
	set defext ""
    } else {
	set defext [string range $f_hardcopy(format) 1 end]
    }
    set nn [file_selection -message "Save to image file?" \
		-default $def_name -title "Save image" \
		-get_dir 0 \
		-warn_overwrite 1 \
		-extra_widgets {picture_file_save_extra_widgets} \
		-new_ok 1 -ok_to_select "" \
		-file_types $types \
		-default_extension $defext \
		-initialdir $hardcopy_auto_dirname]
    if {$nn == ""} { return 0 }
    
    set f_type [file extension $nn ]
    set fname $nn
    set hardcopy_auto_dirname [file dirname $nn]

    set ok 0
    foreach typename $types {
	if {$f_type == [lindex $typename 1]} {set ok 1; break}
	if {$f_type == $f_hardcopy(format)} {set ok 1}
    }
    if !$ok {
	set sfx [string trimleft $f_hardcopy(format) "*"]
	set fname "[ string range $fname 0  end-[string length $f_type] ]$sfx"
	#set f_type $sfx
    } else {	
	set sfx "$f_type"
    }

    set f_hardcopy(format) *$f_type
    
    set f_type [file extension $fname ]
    set f_hardcopy(outfile) [ string range $fname 0  end-[string length "$sfx"] ]
    
    # not sure why this is  here -wayne
    if { ("*$sfx" == "*.jpg")} {
	#set f_hardcopy(format) *.jpeg
    } elseif { ("*$sfx" == "*.xwd")} {
	#set f_hardcopy(format) *.x
    }
    
    if {$f_hardcopy(outfile) == ""} {
	user_error "No image file name given"
	return 0
    }
    
    mess "Saving image \"$f_hardcopy(outfile)$f_type\"\n"
    busy 1
    
    # save the image, passing the options from the Options window
    if {[info exists use_blt_graph] && $use_blt_graph && ([winfo class $sub] != "Tdv_Viewer")} {
        blt_hardcopy_create f 
    } else {
        hardcopy_create f 
    }
    
    set message_save_directory [directory]
    
    mess "Done saving.\n"
    busy 0
    return 1
}

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) [file tail $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 { {print_type ""} } {
    global hardcopy bindir job_name is_win toplevel tdv_default
    global p_hardcopy f_hardcopy tdv_last_viewer_clicked banner_window_used
    
    if {($print_type!="")} {
	# copy the f/p array to hardcopy
	array set hardcopy [array get ${print_type}_hardcopy ]
    }
    
    
    set sum_x [expr $hardcopy(xstart) +  $hardcopy(width) ]
    set sum_y [expr $hardcopy(ystart) +  $hardcopy(height) ]
    set wx $hardcopy(max_width)
    set wy $hardcopy(max_height)
    if { $sum_x > $wx ||  $sum_y > $wy } {
	mess "Warning: values lie outside the limits of the view window (0 - $wx) x (0 - $wy)\n" red
	set hardcopy(xstart) 0
	set hardcopy(ystart) 0
	set hardcopy(width) $wx
	set hardcopy(height) $wy
    }
    
    if { $hardcopy(xstart) < 0 || $hardcopy(ystart) < 0 || $hardcopy(width) < 0 ||$hardcopy(height) < 0 } {
	mess "Negative values not allowed. View window is (0 - $wx) x (0 - $wy) \n" red
	return
    }
    
    foreach v {top sub startcmd endcmd} { set $v $hardcopy(${v}_current) }
    
    hardcopy_defaults
    
    # if {($startcmd != "") && ($hardcopy(format) != "ps")} { eval $startcmd }
    if {$startcmd != ""} { set sub [eval $startcmd] }

    set oldmessage [banner ""]
    set oldmessage_win $banner_window_used
    
    set after ""; set after_o ""
    set directps 0
    set do_print 0
    set suff2 not_used
    set cmd ""
    
    switch $hardcopy(format) {
	*.ps {
	    set cmd "\"$bindir/pnmtops\" "
	    set suff ps
	    set directps $hardcopy(ps_direct)
	    set do_print $hardcopy(send_to_printer)
	}
	*.tiff {
	    set cmd "\"$bindir/pnmtotiff\" "
	    set suff tiff
	}
	*.x {
	    set cmd "\"$bindir/pnmtoxwd\" "
	    set suff xwd
	}
	*.gif {
	    set cmd "\"$bindir/ppmtogif\" "
	    set suff gif
	}
	*.jpeg - *.jpg {
	    #set cmd "\"$bindir/cjpeg\" -quality $hardcopy(jpeg_quality) "
	    #set suff jpg
	    
	    set cmd "cat "
	    set suff ppm
	    if $is_win {
		set after "\"$bindir/cjpeg\" -quality $hardcopy(jpeg_quality) "
	    } else {
		set after_o "\"$bindir/cjpeg\" -quality $hardcopy(jpeg_quality) "
	    }
	    set suff2 jpg
	}
	*.ppm {
	    set cmd "cat "
	    set suff ppm
	}
	*.rgb {
	    set cmd "cat "
	    set suff ppm
	    set after \"$bindir/fromppm\"
	    set suff2 rgb
	}
	*.win {
	    if [catch {$sub mswin_print [file tail $job_name] \
			   $hardcopy(ps_title) \
			   $hardcopy(ps_label) color $hardcopy(ps_frame) \
			   $hardcopy(landscape) $hardcopy(win_direct)} res] {
		global errorInfo
		user_error "$res $errorInfo"
		mess "File not printed.\n"
	    } else {
		mess "Done printing.\n"
		if {$endcmd != ""} { eval $endcmd }
	    }
	    return
	}
	*.vrml {
	    set suff vrml
	}
	default {
	    user_error "Unknown output format $hardcopy(format)"
	    return
	}
    }
    
    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) == "*.gif") || ($hardcopy(format) == "*.x") \
                 || ($hardcopy(format) == "*.tiff")} {
       set cmd "\"$bindir/ppmquant\" 256 | $cmd"
    }
    
    if {$hardcopy(scale) != 1} {
	set cmd "\"$bindir/pnmscale\" $hardcopy(scale) | $cmd "
    }
    set orient portrait
    if $hardcopy(landscape) {
	set orient landscape
	#set cmd "\"$bindir/pnmflip\" -rotate90 | $cmd "
    }
    
    if $directps {
	if $hardcopy(ps_labels) {
	    set title $hardcopy(ps_title)
	    set label $hardcopy(ps_label)
	} else {
	    set title ""
	    set label ""
	}
	switch $hardcopy(ps_color) {
	    color {
		mess "Saving color$hardcopy(ps_type) postscript image to file\
			\"$file\" ...\n"
		$sub postscript $file $title $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 $title $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 $title $label \
		    mono$hardcopy(ps_type) $hardcopy(ps_frame)
		cmap_bnw $sub 0
	    }
	}
    
	if $do_print {
	    set cmd [get_print_cmd $file ps]
	    mess "Sending to printer...\n"
	    if [catch "exec $cmd" res] {
		user_error $res
		banner $oldmessage $oldmessage_win
		return
	    } else {
		mess "Done.\n"
	    }
	}
	if {$endcmd != ""} { eval $endcmd }
	banner $oldmessage $oldmessage_win
	return
    }
    
    set errf [directory]/plot_output.tmp
    
    switch $hardcopy(region_type) {
	all {
	    foreach i {xstart ystart width height} { set hardcopy($i) 0 }
	}
	explicit { }
	screen {
	    banner "Select the area to write out by dragging a box with the left button." $top
	    set bb [tdv_get_rubbox $sub]
	    banner "" $top
	    if {$bb == ""} {
		banner $oldmessage $oldmessage_win
		return
	    }
	    
	    set hardcopy(xstart) [lindex [lindex $bb 0] 0]
	    
	    set hardcopy(ystart) [lindex [lindex $bb 0] 1]
	    if { [ lindex [lindex $bb 1] 0 ] < [ lindex [lindex $bb 0] 0 ] } {
		set hardcopy(xstart) [lindex [lindex $bb 1] 0] }
	    if { [ lindex [lindex $bb 1] 1 ] > [ lindex [lindex $bb 0] 1 ] } {
		set hardcopy(ystart) [lindex [lindex $bb 1] 1] }
	    set hardcopy(ystart) [expr [winfo height $sub] - $hardcopy(ystart)]
	    set hardcopy(width)  [expr {abs([lindex [lindex $bb 1] 0] - [lindex [lindex $bb 0] 0])}]
	    set hardcopy(height) [expr {abs([lindex [lindex $bb 1] 1] - [lindex [lindex $bb 0] 1])}]
	    mess "Selected: ..\n"
	}
    }
    
    if {($hardcopy(format) == "*.vrml")} {
	$sub write_vrml $file
	mess "Done writing output.\n"
	banner $oldmessage $oldmessage_win
	return
    }

    
    append cmd "> \"$file\" 2> \"$errf\""
    
    regsub -all \\\\ $cmd / cmd
    
    mess "Running | $cmd\n"

    set fp [open "| $cmd" w]
    fconfigure $fp -translation binary

    raise $top; after 1
    
    $sub redraw; $sub redraw; update

    busy 1
    mess "Capturing screen image ...\n"
    if [catch {$sub write_ppm $fp $orient $hardcopy(invert) $hardcopy(xstart) \
		   $hardcopy(ystart) \
		   $hardcopy(width) $hardcopy(height)} res] {
	banner $oldmessage $oldmessage_win; user_error $res; return
    }
 

    if $toplevel(single) { lower $top }
    
    catch {flush $fp}
    if [catch {close $fp} res] { user_error $res; return }
    
    set fp [open $errf r]
    mess [read $fp]
    close $fp
    cmd_rm $errf

    banner $oldmessage $oldmessage_win
    
    if {$after != ""} {
	set cmd "$after \"$file\" \"$file2\""
	mess "Running $cmd\n"
	if [catch {eval exec $cmd} res] {
	    mess $res red
	}
	set file $hardcopy(outfile).$suff2
    }
    if {$after_o != ""} {
        set cmd "$after_o \"$file\" > \"$file2\""
        mess "Running $cmd\n"
        if [catch {eval exec $cmd} res] {
            mess $res red
        }
        set file $hardcopy(outfile).$suff2
    }
    
    mess "Done writing output.\n"
    busy 0
    
    if {$endcmd != ""} { eval $endcmd }
    
    if $do_print {
	set cmd [get_print_cmd $file ps]
	mess "Sending to printer...\n"
	eval exec $cmd
	mess "Done.\n"
    }
}

proc hardcopy_write_file {args} {
    global f_hardcopy tdv_default
    
    set f_hardcopy(max_width) [winfo width $tdv_default]
    set f_hardcopy(max_height) [winfo height $tdv_default]
    
    set f_hardcopy(startcmd_current) ""
    set f_hardcopy(endcmd_current) ""
    set f_hardcopy(top_current) .v
    set f_hardcopy(sub_current) $tdv_default
    set f_hardcopy(send_to_printer) 0
    
    foreach {n v} $args { set f_hardcopy($n) $v }
    hardcopy_create f
}

proc blt_hardcopy_create { {print_type ""} } {
    global hardcopy bindir job_name is_win toplevel tdv_default
    global p_hardcopy f_hardcopy tdv_last_viewer_clicked banner_window_used
    global curve_graph
    
    if {($print_type!="")} {
	# copy the f/p array to hardcopy
	array set hardcopy [array get ${print_type}_hardcopy]
    }
    
    
    set sum_x [expr $hardcopy(xstart) +  $hardcopy(width)]
    set sum_y [expr $hardcopy(ystart) +  $hardcopy(height)]
    set wx $hardcopy(max_width)
    set wy $hardcopy(max_height)
    if { $sum_x > $wx ||  $sum_y > $wy } {
	mess "Warning: values lie outside the limits of the view window (0 - $wx) x (0 - $wy)\n" red
	set hardcopy(xstart) 0
	set hardcopy(ystart) 0
	set hardcopy(width) $wx
	set hardcopy(height) $wy
    }
    
    if { $hardcopy(xstart) < 0 || $hardcopy(ystart) < 0 || $hardcopy(width) < 0 ||$hardcopy(height) < 0 } {
	mess "Negative values not allowed. View window is (0 - $wx) x (0 - $wy) \n" red
	return
    }
    
    foreach v {top sub startcmd endcmd} {
      set $v $hardcopy(${v}_current)
    }
    
    hardcopy_defaults
    
    if {$startcmd != ""} { set sub [eval $startcmd] }
    
    set oldmessage [banner ""]
    set oldmessage_win $banner_window_used
    
    set after ""; set after_o ""
    set directps 0
    set do_print 0
    set suff2 not_used
    set cmd ""

    switch $hardcopy(format) {
	*.ps {
	    set cmd "\"$bindir/pnmtops\" "
	    set suff ps
	    set directps $hardcopy(ps_direct)
	    set do_print $hardcopy(send_to_printer)
	}
	*.tiff {
	    set cmd "\"$bindir/pnmtotiff\" "
	    set suff tiff
	}
	*.x {
	    set cmd "\"$bindir/pnmtoxwd\" "
	    set suff xwd
	}
	*.gif {
	    set cmd "\"$bindir/ppmtogif\" "
	    set suff gif
	}
	*.jpeg - *.jpg {
	    if $is_win {
	       set cmd "cat "
	       set suff ppm
	       set after "\"$bindir/cjpeg\" -quality $hardcopy(jpeg_quality) "
	    } else {	    
	       set cmd "\"$bindir/cjpeg\" -quality $hardcopy(jpeg_quality) "
	       set suff jpg
	    }
	}
	*.ppm {
	    set cmd "cat "
	    set suff ppm
	}
	*.rgb {
	    set cmd "cat "
	    set suff ppm
	    set after \"$bindir/fromppm\"
	    set suff2 rgb
	}
	default {
	    user_error "Unknown output format $hardcopy(format)"
	    return
	}
    }
    
    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
    }
  
    set orient portrait
    if $hardcopy(landscape) {
	set orient landscape
	#set cmd "\"$bindir/pnmflip\" -rotate90 | $cmd "
    }
    
    if $directps {
	if $hardcopy(ps_labels) {
	    set title $hardcopy(ps_title)
	    set label $hardcopy(ps_label)
	} else {
	    set title ""
	    set label ""
	}
	set hardcopy(width) [$sub cget -width]
	set hardcopy(height) [$sub cget -height]
	if {$hardcopy(width) >= $hardcopy(height)} {
	  set hardcopy(landscape) 1
	} else {
	  set hardcopy(landscape) 0
	}
	switch $hardcopy(ps_color) {
	    color {
		mess "Saving color$hardcopy(ps_type) postscript image to file\
			\"$file\" ...\n"
		$sub postscript configure -maxpect 1 -landscape $hardcopy(landscape) \
		    -colormode color -decorations $hardcopy(ps_frame) -padx 10 -pady 10
		$sub postscript output $file 
	    }
	    gray {
		mess "Saving gray$hardcopy(ps_type) postscript image to file\
			\"$file\" ...\n"
		$sub postscript configure -maxpect 1 -landscape $hardcopy(landscape) \
		    -colormode gray -decorations $hardcopy(ps_frame) -padx 10 -pady 10
		$sub postscript output $file 
	    }
	    mono {
		mess "Saving mono$hardcopy(ps_type) postscript image to file\
			\"$file\" ...\n"
		$sub postscript configure -maxpect 1 -landscape $hardcopy(landscape) \
		    -colormode mono -decorations $hardcopy(ps_frame) -padx 10 -pady 10
		$sub postscript output $file 
	    }
	}
    
	if $do_print {
	    set cmd [get_print_cmd $file ps]
	    mess "Sending to printer...\n"
	    if [catch "exec $cmd" res] {
		user_error $res
		banner $oldmessage $oldmessage_win
		return
	    } else {
		mess "Done.\n"
	    }
	}
	if {$endcmd != ""} { eval $endcmd }
	banner $oldmessage $oldmessage_win
	return
    }
    
    set errf [directory]/plot_output.tmp
    switch $hardcopy(region_type) {
	all {
	    foreach i {xstart ystart width height} { set hardcopy($i) 0 }
	}
	explicit { }
	screen {
	    set curve_graph(zoom,print,start) 1
	    banner "Select the area to write out by dragging a box with the left button." $sub
	    set bb [busy 0]
	    tkwait variable curve_graph(zoom,print,end)
	    banner "" $sub
	    set bb $curve_graph(zoom,print,end)
	    catch { unset curve_graph(zoom,print,start) }
	    catch { unset curve_graph(zoom,print,end) }	    
	    if {$bb == ""} {
		banner $oldmessage $oldmessage_win
		return
	    }
	    set hardcopy(xstart) [lindex $bb 0]	    
	    set hardcopy(ystart) [lindex $bb 1]
	    if {[lindex $bb 0] < [lindex $bb 2]} {
		set hardcopy(xstart) [lindex $bb 0]
		set xend [lindex $bb 2]
	    } else {
	        set hardcopy(xstart) [lindex $bb 2]
	        set xend [lindex $bb 0]
	    }
	    if {[lindex $bb 1] < [lindex $bb 3]} {
		set hardcopy(ystart) [lindex $bb 1]
		set yend [lindex $bb 3]
	    } else {
	        set hardcopy(ystart) [lindex $bb 3]
	        set yend [lindex $bb 1]
	    }
	    set hardcopy(width)  [expr abs($xend - $hardcopy(xstart))]
	    set hardcopy(height) [expr abs($yend - $hardcopy(ystart))]
	    mess "Selected: ..\n"
	}
    }
        
    set tmp_file [file rootname $file].tmp.ppm
    append cmd "$tmp_file > \"$file\" 2> \"$errf\""
    
    regsub -all \\\\ $cmd / cmd
    
    mess "Running | $cmd\n"

    busy 1
    mess "Capturing screen image ...\n"
    if [catch {set im [image create photo -palette 256/256/256]} res] {
	banner $oldmessage $oldmessage_win; user_error $res; return
    }
    if [catch {$sub snap $im} res] {
	banner $oldmessage $oldmessage_win; user_error $res; return
    }
    switch $hardcopy(region_type) {
	screen {
            if [catch {set im2 [image create photo -palette 256/256/256]} res] {
	        banner $oldmessage $oldmessage_win; user_error $res; return
            }
            if [catch {$im2 copy $im -from $hardcopy(xstart) $hardcopy(ystart) \
                    $xend $yend} res] {
	        banner $oldmessage $oldmessage_win; user_error $res; return
            } else {
                image delete $im
                set im $im2
            }
        }
    }
    if [catch {$im write -format ppm $tmp_file} res] {
	banner $oldmessage $oldmessage_win; user_error $res; return
    }
    if {!$is_win && $hardcopy(scale) != 1} {
	set tmp_scale_file $tmp_file.scale
	if [catch {eval exec $bindir/pnmscale $hardcopy(scale) $tmp_file \
	         > $tmp_scale_file} res] {
	    banner $oldmessage $oldmessage_win; user_error $res; return
        } else {
            cmd_mv $tmp_scale_file $tmp_file
        }
    }
    if [catch {eval exec $cmd} res] {
        banner $oldmessage $oldmessage_win; user_error $res; return
    } else {
        cmd_rm $tmp_file
    }

    if {$is_win && $after != ""}  {
	switch $hardcopy(format) {
	    *.jpeg - *.jpg {
	        set file2 $pref.jpg
	        set cmd "$after \"$file\" \"$file2\""
	        regsub -all \\\\ $cmd / cmd
	        mess "Running $cmd\n"
	        if [catch {eval exec $cmd} res] {
	            mess $res red
	        } else {
	            cmd_rm $file
	            set file $file2
	        }
	    }
	}
    }
   
    set fp [open $errf r]
    mess [read $fp]
    close $fp
    cmd_rm $errf

    banner $oldmessage $oldmessage_win
   
    mess "Done writing output.\n"
    
    busy 0
    
    if {$endcmd != ""} { eval $endcmd }
    
    if $do_print {
	set cmd [get_print_cmd $file ps]
	mess "Sending to printer...\n"
	eval exec $cmd
	mess "Done.\n"
    }
}


# ----------------------------------------------------------

proc animate_okay {type} {
    global auto_animate
    
    # now check if mpeg - only values of :
    # 23.976, 24, 25, 29.97, 30, 50, 59.94, 60 allowed
    if { $auto_animate($type,how) == "mpeg" && \
	     $auto_animate($type,delay) != 23.976   && \
	     $auto_animate($type,delay) != 24   && \
	     $auto_animate($type,delay) != 25   && \
	     $auto_animate($type,delay) != 29.97   && \
	     $auto_animate($type,delay) != 30   && \
	     $auto_animate($type,delay) != 50   && \
	     $auto_animate($type,delay) != 59.94   && \
	     $auto_animate($type,delay) != 60   } {
	set mm "The only valid values of Frames per second for mpeg files are: 23.976, 24, 25, 29.97, 30, 50, 59.94, 60"
	return $mm
    }
    
    if {($auto_animate($type,how) != "screen") && ($auto_animate($type,delay) == 0)} {
	set mm "Value of Frames per second should not be zero"
	return $mm
    }
    
    return
}

# ----------------------------------------------------------
# Stuff for animation of cut planes, particle traces, etc

proc auto_animation_form {form title slab sval elab eval varname
			  update_func active valuefield defnsteps
			  type {suff ""}} {
    global auto_animate tdv_last_viewer_clicked animate_auto_dirname
    global post_timetype
    
    set only_write [expr {$slab == ""}]
    
    if !$only_write {
	set auto_animate($type,minval) $sval
	set auto_animate($type,maxval) $eval
	set auto_animate($type,nsteps) $defnsteps
	set auto_animate($type,startp) $sval
	set auto_animate($type,endp) $eval
    }
    if !$valuefield { set auto_animate($type,useincrval) 0 }
    
    set types {
	{{GIF files}       {.gif}}
	{{MPEG files}      {.mpg}}
	{{AVI files}       {.avi}}
	{{FLI files}       {.fli}}
	{{Flash files}       {.swf}}
    }
    
    set nn [file_selection -message "Save to animation file?" \
		-default [directory]/animation.gif -title "Save animation" \
		-get_dir 0 -warn_overwrite 1 -new_ok 1 \
		-extra_widgets [list animation_file_extra_widgets \
				    $slab $sval $elab $eval $varname \
				    $update_func $active $valuefield \
				    $defnsteps $type] \
		-ok_to_select "" -file_types $types \
		-default_extension .gif \
		-initialdir $animate_auto_dirname ]
    
    if {$nn == ""} { return 0 }

    set f_type [file extension $nn ]
    set fname $nn

    set ok 0
    foreach typename $types {
	if {$f_type == [lindex $typename 1]} {set ok 1; break}
	if {[info exists auto_animate($type,file_type)] && $auto_animate($type,file_type) == $f_type} {set ok 1}
    }
    if !$ok {
	set sfx [string trimleft $f_hardcopy(format) "*"]
	set fname "[ string range $fname 0  end-[string length $f_type] ]$sfx"
	#set f_type $sfx
    } else {	
	set sfx "$f_type"
    }

    set auto_animate($type,file_type) *$f_type

    set f_type [file extension $fname ]
    set outfile [ string range $fname 0  end-[string length "$sfx"] ]
    
    if {$outfile == ""} {
	user_error "No animation file name given"
	return 0
    }
    
    set animate_auto_dirname [file dirname $nn]
    switch -- $auto_animate($type,file_type) {
	*.mpg { set auto_animate($type,how) mpeg }
	*.gif { set auto_animate($type,how) gif }
	*.avi { set auto_animate($type,how) avi }
	*.fli { set auto_animate($type,how) fli }
	*.swf { set auto_animate($type,how) swf }
    }    
    if !$auto_animate($type,to_file) { set auto_animate($type,how) screen }
    set mm [animate_okay $type]
    if {$mm == ""} {
	auto_do_animate $varname "$update_func" $fname $suff $type
    } else {
	user_error $mm
    }
    return
    
}

proc animation_file_extra_widgets {slab sval elab eval varname \
				       update_func active valuefield \
				       defnsteps type d} {
    global picture_file_save
    global f_hardcopy
    
    set bw 8
    form_button $d.optbut "Options ..." \
	[list animation_file_extra_widgets_form $slab $sval $elab $eval \
	     $varname $update_func $active $valuefield $defnsteps $type] {}
    $d.optbut configure -width $bw
    # We have to do this to make these widgets line up with the ones above.
    pack $d.optbut -side right -padx 4 -anchor e
    
    return ""
}

proc animation_file_extra_widgets_form {slab sval elab eval varname \
					    update_func active valuefield \
					    defnsteps type} {
    global auto_animate tdv_last_viewer_clicked
    
    set only_write [expr {$slab == ""}]
    
    if !$valuefield { set auto_animate($type,useincrval) 0 }
    if !$only_write {
	set auto_animate($type,nsteps) $defnsteps
	set auto_animate($type,startp) $sval
	set auto_animate($type,endp) $eval
    }
    if { $auto_animate($type,width) == 0} {
	set auto_animate($type,width) [ winfo width $tdv_last_viewer_clicked ]
    }
    if { $auto_animate($type,height) == 0} {
	set auto_animate($type,height) [ winfo height $tdv_last_viewer_clicked ]
    }
    
    
    set d [form_init .animation_options_${only_write}_$valuefield \
	       "Save animation options"]
    if {$d == ""} {
	# for some reason this is needed to sync up the menuentry_listbox
	set auto_animate($type,region_type) $auto_animate($type,region_type)
	return
    }
    if !$only_write {
	form_label $d.spl $slab {1 0} $active
	form_label $d.epl $elab {2 0} $active
	form_entry $d.sp auto_animate($type,startp) float {1 1} $active
	form_entry $d.ep auto_animate($type,endp) float {2 1} $active
	
	form_label $d.del "Frames per second" {5 0} $active
    }
    form_label $d.scalel "Scale factor:" {6 0} \
	[concat $active [list [list auto_animate($type,how) mpeg avi gif fli swf]]]
    
    if !$only_write {
	if $valuefield {
	    form_radiobutton $d.nsl "Num steps" auto_animate($type,useincrval) 0 \
		{3 0} $active
	    form_radiobutton $d.ivl "Incr value" auto_animate($type,useincrval) 1 \
		{4 0} $active
	    form_entry $d.ns auto_animate($type,nsteps) int {3 1} \
		[concat $active [list [list auto_animate($type,useincrval) 0]]]
	    form_entry $d.iv auto_animate($type,incrval) float {4 1} \
		[concat $active [list [list auto_animate($type,useincrval) 1]]]
	} else {
	    form_label $d.nsl "Num steps" {3 0} $active
	    form_entry $d.ns auto_animate($type,nsteps) int {3 1} $active
	}
	form_entry $d.de auto_animate($type,delay) float {5 1} $active
    }
    form_entry $d.scale auto_animate($type,scale) float {6 1} \
	[concat $active [list [list auto_animate($type,how) mpeg avi gif fli swf]]]
    
    if !$only_write {
	form_checkbutton $d.loop "Loop mode" auto_animate($type,loop) {7 0 -cols -} \
	    [concat $active [list [list auto_animate($type,how) gif fli screen]]]
	
	form_radiobutton $d.hows "Only screen display" auto_animate($type,how) \
	    screen {10 0 -cols 2} $active
    }
    
    # here want a little frame for region selection - 
    # only active if NOT a screen display
    set not_screen [concat $active [list [list auto_animate($type,how) "avi" "gif" "fli" "swf" "mpeg"]]]
    # now the region selection buttons
    form_frame $d.formr ridge 2 {50 0 -cols 5}
    
    form_label $d.formr.formreg "Print region:" {0 0 -cols 2} $not_screen
    futil_menuentry_labels $d.formr.rtype auto_animate($type,region_type) \
	{list {all "Full screen"} {screen "Mouse selection"} \
	     {explicit "Pixel location"}} {0 2 -cols 2} $not_screen
    
    set act_ex [list [list auto_animate($type,region_type) explicit] $not_screen ]
    
    form_label $d.formr.xsl "Left" {6 0 -cols 1} $act_ex 
    form_entry $d.formr.xs auto_animate($type,xstart) float {6 1}  $act_ex
    
    form_label $d.formr.wl "Width" {6 2 -cols 1}  $act_ex
    form_entry $d.formr.w auto_animate($type,width) float {6 3 -cols 1}  $act_ex
    
    form_label $d.formr.ysl "Bottom" {7 0 -cols 1}  $act_ex
    form_entry $d.formr.ys auto_animate($type,ystart) float {7 1 -cols 1}  $act_ex
    
    form_label $d.formr.hl "Height" {7 2 -cols 1}  $act_ex
    form_entry $d.formr.h auto_animate($type,height) float {7 3 -cols 1}  $act_ex
    
    # end of region selecting buttons
    
    form_finish +300+300
}

proc auto_animate_subform {aoptf {type default} {ptrace 0}} {
    form_label $aoptf.startl Start {0 0}
    form_label $aoptf.endl End {0 2}
    form_label $aoptf.stepsl Steps {1 0}
    form_label_variable $aoptf.fpsl auto_animate($type,fps_text) {1 2}
#    form_label $aoptf.dell "Delay (ms)" {1 2} $act_delay
    
    form_entry $aoptf.start auto_animate($type,startp) float {0 1} 4
    form_entry $aoptf.end auto_animate($type,endp) float {0 3} 4
    form_entry $aoptf.steps auto_animate($type,nsteps) float {1 1} 4
    form_entry $aoptf.fps auto_animate($type,delay) float {1 3} 4
    
    form_checkbutton $aoptf.file "Write to file" auto_animate($type,to_file) {2 0 -cols 2}
    form_checkbutton $aoptf.loop "Loop mode" auto_animate($type,loop) {2 2 -cols 2}
    set cmd "\
	if \$auto_animate($type,to_file) \{ \
	    set auto_animate($type,button_lab) Write ; \
	    set auto_animate($type,fps_text) {Frames/s} \
	\} else \{ \
	    set auto_animate($type,button_lab) Animate ; \
	    set auto_animate($type,fps_text) {Delay (ms)} \
	\} \
    "
    $aoptf.file configure -command $cmd
    uplevel \#0 $cmd
}

proc auto_animate_stop {type} {
    global auto_animate
    
    set auto_animate($type,stop) 1
    set auto_animate($type,go) 0
}

proc check_then_animate {varname update_func suff type} {
    global auto_animate
    
    if !$auto_animate($type,to_file) { set auto_animate($type,how) screen }
    set mm [animate_okay $type]
    if {$mm == ""} {
        auto_do_animate $varname "$update_func" "" $suff $type
        return
    }
    user_error $mm
}

proc auto_animate_initialize_vars {type} {
    global auto_animate
    foreach v [array names auto_animate] {
	set vv [split $v ,]
	if {[lindex $vv 0] == "default"} {
	    set auto_animate($type,[lindex $vv 1]) $auto_animate($v)
	}
    }
}

proc auto_do_animate {varname update_func outfile suff type} {
    global tdv_last_viewer_clicked tdv_default
    global auto_animate bindir

    upvar \#0 $varname pct_var
    
    if ![winfo exists $tdv_last_viewer_clicked] {
	set win $tdv_default
    } else {
	set win $tdv_last_viewer_clicked
    }
    
    
    if $auto_animate($type,running) {
	mess "Animation is already running!\n" red
	return
    }
        
    #    set outfile ""
    if {[info exists auto_animate($type,to_file)]} {
	if {$auto_animate($type,to_file) == 0} {
	    set auto_animate($type,how) screen
	}
    }
    
    set prefix ""
    if {[string match post_update_transient $update_func]} {
	set prefix "transient_"
    }
    switch $auto_animate($type,how) {
	screen {
	    foreach i {xstart ystart width height} { set auto_animate($type,$i) 0 }
	}
	default {
	    switch $auto_animate($type,region_type) {
		all {
		    foreach i {xstart ystart width height} { set auto_animate($type,$i) 0 }
		}
		explicit { }
		screen {
		    banner "Select the area to write out by dragging a box with the left button."
		    set bb [tdv_get_rubbox $win]
		    banner ""
		    if {$bb == ""} return
		    
		    set auto_animate($type,xstart) [lindex [lindex $bb 0] 0]
		    
		    set auto_animate($type,ystart) [lindex [lindex $bb 0] 1]
		    if { [ lindex [lindex $bb 1] 0 ] < [ lindex [lindex $bb 0] 0 ] } {
			set auto_animate($type,xstart) [lindex [lindex $bb 1] 0] }
		    if { [ lindex [lindex $bb 1] 1 ] > [ lindex [lindex $bb 0] 1 ] } {
			set auto_animate($type,ystart) [lindex [lindex $bb 1] 1] }
		    set auto_animate($type,ystart) [expr [winfo height $win] - $auto_animate($type,ystart)]
		    set auto_animate($type,width)  [expr {abs([lindex [lindex $bb 1] 0] - [lindex [lindex $bb 0] 0])}]
		    set auto_animate($type,height) [expr {abs([lindex [lindex $bb 1] 1] - [lindex [lindex $bb 0] 1])}]
		    mess "Selected: ..\n"
		}
	    }
	}
    }
    
    # here check if the values are OK before starting the animation
    set sum_x [expr $auto_animate($type,xstart) +  $auto_animate($type,width) ]
    set sum_y [expr $auto_animate($type,ystart) +  $auto_animate($type,height) ]
    set wx [ winfo width $win ]
    set wy [ winfo height $win ]
    if { $sum_x > $wx ||  $sum_y > $wy } {
	mess "Values lie outside the limits of the view window (0 - $wx) x (0 - $wy) \n" red
	set hardcopy(xstart) 0
	set hardcopy(ystart) 0
	set hardcopy(width) $wx
	set hardcopy(height) $wy
    }
    
    if { $auto_animate($type,xstart) < 0 || $auto_animate($type,ystart) < 0 || $auto_animate($type,width) < 0 ||$auto_animate($type,height) < 0 } {
	mess "Negative values not allowed. View window is (0 - $wx) x (0 - $wy) \n" red
	set auto_animate($type,running) 0
	set auto_animate($type,${prefix}button_lab) Animate
	set auto_animate($type,stop) 1
	return
    }

    # end of checking the values
    
    if {$outfile == ""} {
	switch $auto_animate($type,how) {
	    mpeg {
		set outfile [file_selection -message "MPEG output file name?" \
				 -default [directory]/movie.mpg \
				 -new_ok 1 -warn_overwrite 1]
		if {$outfile == ""} return
		if {[file extension $outfile] == ""} { append outfile .mpg }
	    }
	    gif {
		set outfile [file_selection -message "GIF output file name?" \
				 -default [directory]/movie.gif \
				 -new_ok 1 -warn_overwrite 1]
		if {$outfile == ""} return
		if {[file extension $outfile] == ""} { append outfile .gif }
	    }
	    fli {
		set outfile [file_selection -message "FLI output file name?" \
				 -default [directory]/movie.fli \
				 -new_ok 1 -warn_overwrite 1]
		if {$outfile == ""} return
		if {[file extension $outfile] == ""} { append outfile .fli }
	    }
	    avi {
		set outfile [file_selection -message "AVI output file name?" \
				 -default [directory]/movie.avi \
				 -new_ok 1 -warn_overwrite 1]
		if {$outfile == ""} return
		if {[file extension $outfile] == ""} { append outfile .avi }
	    }
	    swf {
		set outfile [file_selection -message "Flash output file name?" \
				 -default [directory]/movie.swf \
				 -new_ok 1 -warn_overwrite 1]
		if {$outfile == ""} return
		if {[file extension $outfile] == ""} { append outfile .swf }
	    }
	    screen { set outfile "" }
	}
    }

    if {($auto_animate($type,minval) == 0) && ($auto_animate($type,maxval) == 1) && ($suff == "")} {
	# This is for cut plane pcts
	if {$auto_animate($type,startp$suff) <= 0.001} {
	    set auto_animate($type,startp$suff) 0.001
	}
	if {$auto_animate($type,endp$suff) >= 0.999} {
	    set auto_animate($type,endp$suff) 0.999
	}
    } else {
	if {$auto_animate($type,startp$suff) <= $auto_animate($type,minval)} {
	    set auto_animate($type,startp$suff) $auto_animate($type,minval)
	}
	if {$auto_animate($type,endp$suff) >= $auto_animate($type,maxval)} {
	    set auto_animate($type,endp$suff) $auto_animate($type,maxval)
	}
    }
    set dif [expr $auto_animate($type,endp$suff) - $auto_animate($type,startp$suff)]
    if $auto_animate($type,useincrval) {
	set incr $auto_animate($type,incrval)
	set auto_animate($type,nsteps$suff) [expr {$dif / ($incr + 0.0) + 1}]
	if {$auto_animate($type,nsteps$suff) < 2} {
	    user_error "Please set the number of steps to be more than 1."
	    return
	}
    } else {
	if {$auto_animate($type,nsteps$suff) < 2} {
	    user_error "Please set the number of steps to be more than 1."
	    return
	}
	set incr [expr {$dif / ($auto_animate($type,nsteps$suff) - 1.0)}]
    }
    
    set auto_animate($type,running) 1
    set auto_animate($type,${prefix}button_lab) Interrupt
    set auto_animate($type,stop) 0
    
    set tmp [directory]/movie_tmp_
    eval cmd_rm [glob_fixed $tmp*]
    
    set del 0
    if {$auto_animate($type,how) == "screen"} {
	if !$auto_animate($type,delay) {
	    set del 0	  
	} else {
	    #	    set del [expr int(1000/($auto_animate($type,delay)+0.0))]
	    # have a delay between frames in milliseconds for the screen animation
	    set del [expr int($auto_animate($type,delay))]
	}
    }
    set infiles ""
    
    top_withdraw_all 1
    interrupt begin "Creating animation" "Animation" 1.0
    
    # Here have added an extra frame - write onto file000, then over it
    # again to see if the problems with the FIRST of the 
    # PPM files can be got round - seems to work OK
    
    # also use this frame to check the size of the scaled ppm file produced
    # FLI has limits on the size of PPM for animation
    eval $update_func
    update
    post_accept "" 0
    
    if {$auto_animate($type,how) != "screen"} {
	set file [create_animation_frame $tmp $auto_animate($type,how) \
		      $auto_animate($type,scale) 0 $auto_animate($type,xstart) \
		      $auto_animate($type,ystart) $auto_animate($type,width) \
		      $auto_animate($type,height)]
	
	set first_ppm $file
	set ppmFile1 [open $first_ppm r]
	
	gets $ppmFile1 magic_ppm
	gets $ppmFile1 ppm_line2
	close $ppmFile1
	set ppm_width [lindex [split $ppm_line2] 0]
	set ppm_height [lindex [split $ppm_line2] 1]
	
	if {($auto_animate($type,how) == "fli")} { 
	    
	    if {(($ppm_width > 1280) || ($ppm_height > 1024))} {
		set sc_h [expr int(1024)*$auto_animate($type,scale)/$ppm_height]
		set sc_w [expr int(1280)*$auto_animate($type,scale)/$ppm_width]
		set new_scale $sc_h	    
		if {$sc_w<$sc_h} {
		    set new_scale $sc_w
		}	    
		user_error "Maximum size of FLI file is 1280x1024. Scale has been adjusted to $new_scale for output"
		set auto_animate($type,scale) $new_scale
	    }
	}
    }
    
    
    # End of PPM fix
    set interrupted 0
    while {!$auto_animate($type,stop)} {
	set pct_var $auto_animate($type,startp$suff)
	for {set i 0} {$i < $auto_animate($type,nsteps$suff) } {incr i} {
	    
	    eval $update_func
	    update
#	    post_accept
	    switch $auto_animate($type,how) {
		screen { }
		default {
		    set file [create_animation_frame $tmp $auto_animate($type,how) \
				  $auto_animate($type,scale) $i \
				  $auto_animate($type,xstart) $auto_animate($type,ystart) \
				  $auto_animate($type,width) $auto_animate($type,height)]
		    lappend infiles $file
		}
	    }
	    set pct [expr ($i + 1) / ($auto_animate($type,nsteps$suff) + 0.0)]
	    if [interrupt update $pct "Frame [expr $i + 1] of $auto_animate($type,nsteps$suff)"] {
		set auto_animate($type,stop) 1
	    }
	    if {$i < $auto_animate($type,nsteps$suff) - 1} {
		
		if $del {
		    if $auto_animate($type,stop) {
			mess "Animation interrupted\n" red
			break
		    }
		    after $del "set auto_animate($type,go) 1"
		    tkwait variable auto_animate($type,go)
		    
		}
		set pct_var [expr $pct_var + $incr]
		if {$pct_var <= $auto_animate($type,minval)} {
		    set pct_var $auto_animate($type,minval)
		}
		if {$pct_var >= $auto_animate($type,maxval)} {
		    set pct_var $auto_animate($type,maxval)
		}
		if $auto_animate($type,stop) {
		    mess "Animation interrupted\n" red
		    break
		}
	    }
	}
	if {!$auto_animate($type,loop) || ($auto_animate($type,how) != "screen")} break
    }
    
    top_withdraw_all 0
    interrupt finish
    
    set auto_animate($type,running) 0
    set auto_animate($type,${prefix}button_lab) Animate
    
    if $auto_animate($type,stop) return
    
    if {$outfile != ""} {
	create_animation $auto_animate($type,how) $auto_animate($type,loop)  $auto_animate($type,delay) $infiles $outfile $ppm_width $ppm_height
	foreach f $infiles { 
	    if {[file exists $f ]} {cmd_rm $f} 
	    cmd_rm $f
	}
	
    }
    set tmp [directory]/movie_tmp_
    eval cmd_rm [glob_fixed $tmp*]
    
    mess "Done with animation.\n"
}

proc create_animation_frame {pref how scale i {x 0} {y 0}  {width 0} {height 0} } {
    global tdv_last_viewer_clicked tdv_default
    global bindir toplevel
    
    if ![winfo exists $tdv_last_viewer_clicked] {
	set win $tdv_default
    } else {
	set win $tdv_last_viewer_clicked
    }
    
    set pref1 ${pref}_tmp.ppm
    set file $pref[format %03d $i].ppm
    set fp [open $pref1 w]
    fconfigure $fp -translation binary
    mess "Capturing screen image $i ...\n"
    
    update
    $win redraw
    update
    $win redraw
    update
    $win write_ppm $fp portrait 0 $x $y $width $height
    
    close $fp


    if {$scale != 1.0 } {
	exec $bindir/pnmscale $scale < $pref1 > $file
	if {[file exists $pref1]} { cmd_rm $pref1 }
    } else {
	cmd_mv $pref1 $file    
    }
    
    return $file
}


proc create_fli_html_file {ppm_width ppm_height outfile loopy del} {
    
    set ppm_html [ file rootname $outfile ]
    set ppm_fli [ file tail $outfile ]
    append ppm_html ".html"

    set loop_num 1
    if { $loopy == 1 } {
	set loop_num -1 }
    
    set file_ppm_html [open $ppm_html w]

    puts $file_ppm_html "<HTML>"
    puts $file_ppm_html "<HEAD>"
    puts $file_ppm_html "<TITLE>$ppm_fli</TITLE>"
    puts $file_ppm_html "</HEAD>"
    puts $file_ppm_html "<CENTER>"
    puts $file_ppm_html "<HR>"
    puts $file_ppm_html "<APPLET code=fliplay.class width=$ppm_width height=$ppm_height>"
    puts $file_ppm_html "<PARAM name=File value=\"$ppm_fli\"> "
    puts $file_ppm_html "<PARAM name=Speed value=$del> "
    puts $file_ppm_html "<PARAM name=Loops value=$loop_num> "
    puts $file_ppm_html "<PARAM name=End value=-1> "
    puts $file_ppm_html "</APPLET>"
    puts $file_ppm_html "<HR></CENTER>"
    puts $file_ppm_html "Try keys:<br>"
    puts $file_ppm_html "<pre>\[SPACE\]\tTo start/stop animation </pre>"
    puts $file_ppm_html "<pre>\[.\]\tTo step forwards</pre>"
    puts $file_ppm_html "<pre>\[,\]\tTo step backwards</pre>"
    puts $file_ppm_html "<pre>\[R\]\tTo change direction</pre>"
    puts $file_ppm_html "<pre>\[+\]\tTo speed up</pre>"
    puts $file_ppm_html "<pre>\[-\]\tTo slow down</pre>"
    puts $file_ppm_html "<pre>\[0\]\tTo revert to original setting</pre>"

    puts $file_ppm_html "</BODY>"
    puts $file_ppm_html "</HTML>"
    close $file_ppm_html
}

proc create_animation {how loopy del infiles outfile {width 0} {height 0}} {
    global bindir autohex_dir
    
    busy 1
    
    # here del is frames per second (can be a float) - this goes to
    # mpeg_encode and ppm2avi directly. But limited range of vals for mpeg
    # ppm2fli  takes speed in 1000ths of seconds
    # gifsicle takes speed in 100ths of seconds
    
    switch $how {
	mpeg {
	    set param [directory]/mpeg.param
	    set fp [open $param w]
	    
	    puts $fp "PATTERN          IBBPBBPBBP"
	    puts $fp "BASE_FILE_FORMAT PPM"
	    puts $fp "GOP_SIZE         30"
	    puts $fp "SLICES_PER_FRAME 1"
	    puts $fp "OUTPUT           $outfile"
	    puts $fp "INPUT_DIR        [directory]"
	    puts $fp "INPUT_CONVERT    *"
	    puts $fp "INPUT"
	    foreach f $infiles {
		puts $fp [file tail $f]
	    }
	    puts $fp "END_INPUT"
	    puts $fp "PIXEL            HALF"
	    puts $fp "FRAME_RATE       $del"
	    # del is in frames per second
	    puts $fp "RANGE            10"
	    puts $fp "PSEARCH_ALG      LOGARITHMIC"
	    puts $fp "BSEARCH_ALG      CROSS2"
	    puts $fp "IQSCALE          8"
	    puts $fp "PQSCALE          10"
	    puts $fp "BQSCALE          25"
	    puts $fp "REFERENCE_FRAME  ORIGINAL"
	    puts $fp "FORCE_ENCODE_LAST_FRAME"
	    close $fp
	    
	    mess "$bindir/mpeg_encode $param\n"
	    catch {exec $bindir/mpeg_encode $param} res
	    mess $res\n orange
	    #set cmd "\"$bindir/mpeg_encode\" \"$param\""
	    #run_background $cmd "" 1
	}
	avi {
	    # GENERATE .avi file
	    # run the ppm2avi procedure	    
	    if [file exists $outfile] { cmd_rm $outfile }
	    
	    set cmd "\"$bindir/ppm2avi\""
	    foreach if $infiles { append cmd " \"$if\"" }
	    append cmd " $del \"$outfile\""
	    # del is in frames per second 
	    run_background $cmd "" 1
	    
	    # MAKE an html file	    
	    mess "The AVI file should run provided your viewer \n"
	    mess "supports uncompressed RGB format AVI files\n"
	    
	}
	swf {
	    # GENERATE .swf file
	    # run the ppm2swf procedure	    
	    if [file exists $outfile] { cmd_rm $outfile }
	    set scale 1.0
	    set cmd "\"$bindir/ppm2swf\""
	    append cmd " \"$outfile\" $del"
	    append cmd " $scale $width $height"
	    foreach if $infiles { append cmd " \"$if\"" }
	    
	    # del is in frames per second 
	    run_background $cmd "" 1	    
	}
	gif {
	    mess "Converting ppm's to gifs...\n"
	    set delay_gif [expr int(100 / ($del + 0.0))] 

	    set infiles2 ""
	    foreach f $infiles {
		set gfile [file rootname $f].gif
		append infiles2 " \"$gfile\""
		catch {exec $bindir/ppmquant 256 < $f | $bindir/ppmtogif > "$gfile"} res
	    }
	    if { $loopy==1 } {
		set cmd "\"$bindir/gifsicle\" --no-warnings --colors 256 --delay=$delay_gif --loop $infiles2 -o \"$outfile\""
	    } else {
		set cmd "\"$bindir/gifsicle\" --colors 256 --no-warnings --delay=$delay_gif --no-loop $infiles2 -o \"$outfile\""
	    }
	    run_background $cmd "" 1
	    foreach f $infiles2 { cmd_rm $f }
	}
	fli {
	    set delay_fli [expr int(1000 / ($del + 0.0))] 
	    set play_class [directory]/fliplay.class
	    set flick_class [directory]/flickframe.class
	    if ![file exists  $play_class] {
		file copy $autohex_dir/fliplay.class $play_class
	    }
	    if ![file exists $flick_class] {
		file copy $autohex_dir/flickframe.class $flick_class
	    }
# GENERATE .fli file
	    set param [directory]/ppm_files.txt
	    set fliSrcFile [open $param w]
	    
	    foreach f $infiles {
		puts $fliSrcFile "$f"
	    }

	    close $fliSrcFile
	    
# want to get the width and height from one of the infiles	    
	    set first_ppm [lindex $infiles 0]
	    set ppmFile1 [open $first_ppm r]
	    
	    gets $ppmFile1 magic_ppm
	    gets $ppmFile1 ppm_line2
	    close $ppmFile1
	    set ppm_width [lindex [split $ppm_line2] 0]
	    set ppm_height [lindex [split $ppm_line2] 1]

	    append ppm_width x $ppm_height
	    # run the ppm2fli procedure
	    if [file exists $outfile] { cmd_rm $outfile }
	    
	    set cmd "\"$bindir/ppm2fli\" -N -g $ppm_width -s $delay_fli -b 2 \"$param\" \"$outfile\""
	    run_background $cmd "" 1
	    create_fli_html_file $ppm_width $ppm_height $outfile $loopy $delay_fli
	    cmd_rm $param
# get the outfile stem
	    
	    set ppm_list [ file split [file rootname $outfile] ]
	    set stem_index [expr [ llength $ppm_list ] - 1]
	    set ppm_stem [ lindex $ppm_list $stem_index]
# MAKE an html file	    
	    mess "To view look at the animation file: \n"
	    mess "With an FLI viewer plug-in, you can open \n"
	    mess "the $ppm_stem.fli file in your web browser.\n"

	    mess "Without a plug-in, open the $ppm_stem.html file instead.\n"
	    mess "The following files must be in the same directory:\n"
	    mess "$ppm_stem.fli, fliplay.class and flickframe.class. \n"

	    mess "The loop option is enabled using these classes and \n"
	    mess "is not applied to the $ppm_stem.fli file itself. \n"
	    
 	    mess "To send to a third party:\n"
	    mess "If they don't have a plug-in, send \n"
	    mess "$ppm_stem.html, $ppm_stem.fli, fliplay.class and flickframe.class \n"
	    mess "Otherwise, send only $ppm_stem.fli\n"
	    mess "Alternatively, mount the $ppm_stem.html file on the web.\n"
	    mess "\n"
	}
    }
    busy 0
}

proc file_hardcopy_ps_form {} {
    global f_hardcopy
    
    f_hardcopy_defaults
    
    set d [form_init .file_hardcopy_ps "File 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" f_hardcopy(ps_type) "" {0 1}
	form_radiobutton $d.typee "EPS" f_hardcopy(ps_type) "_eps" {1 1}
	
	form_label $d.model "Mode" {5 0}
	form_radiobutton $d.modec "Color" f_hardcopy(ps_color) color {5 1}
	form_radiobutton $d.modeg "Gray" f_hardcopy(ps_color) gray {6 1}
	form_radiobutton $d.modem "Mono" f_hardcopy(ps_color) mono {7 1}
	
	form_checkbutton $d.frame "Include frame" f_hardcopy(ps_frame) {10 0 -cols 2}
	form_label $d.titlel "Title (top of page)" {15 0 -cols 2}
	form_entry $d.title f_hardcopy(ps_title) string {16 0 -cols 2}
	form_label $d.labell "Label (bottom of page)" {17 0 -cols 2}
	form_entry $d.label f_hardcopy(ps_label) string {18 0 -cols 2}
	
	form_finish bot
    }
}



proc print_hardcopy_ps_form {} {
    global hardcopy
    
    p_hardcopy_defaults
    
    set d [form_init .print_hardcopy_ps "Printer 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" p_hardcopy(ps_type) "" {0 1}
	form_radiobutton $d.typee "EPS" p_hardcopy(ps_type) "_eps" {1 1}
	
	form_label $d.model "Mode" {5 0}
	form_radiobutton $d.modec "Color" p_hardcopy(ps_color) color {5 1}
	form_radiobutton $d.modeg "Gray" p_hardcopy(ps_color) gray {6 1}
	form_radiobutton $d.modem "Mono" p_hardcopy(ps_color) mono {7 1}
	
	form_checkbutton $d.frame "Include frame" p_hardcopy(ps_frame) {10 0 -cols 2}
	form_label $d.titlel "Title (top of page)" {15 0 -cols 2}
	form_entry $d.title p_hardcopy(ps_title) string {16 0 -cols 2}
	form_label $d.labell "Label (bottom of page)" {17 0 -cols 2}
	form_entry $d.label p_hardcopy(ps_label) string {18 0 -cols 2}
	

	
	#form_checkbutton $d.print "Send to printer" p_hardcopy(send_to_printer) \
	 \#   {20 0 -cols 2} {{p_hardcopy(format) ps}}
	
	form_finish bot
    }
}

proc hardcopy_win_form {} {

    global p_hardcopy
    
    p_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" p_hardcopy(ps_color) color {5 1}
	form_radiobutton $d.modeg "Gray" p_hardcopy(ps_color) gray {6 1}
	form_radiobutton $d.modem "Mono" p_hardcopy(ps_color) mono {7 1}
	
	form_checkbutton $d.frame "Include frame" p_hardcopy(ps_frame) {10 0 -cols 2}
	form_label $d.titlel "Title (top of page)" {15 0 -cols 2}
	form_entry $d.title p_hardcopy(ps_title) string {16 0 -cols 2}
	form_label $d.labell "Label (bottom of page)" {17 0 -cols 2}
	form_entry $d.label p_hardcopy(ps_label) string {18 0 -cols 2}
	
	form_finish bot
    }
}


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

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

