#!/usr/local/bin/wish -f

if { [file exists ./FSBox.t]  ==  0} { puts "Error: dwm-view-9 must be invoked from the directory where it is located."; exit; }

source ./FSBox.t

set canvas_physical_x_size 175
set canvas_physical_y_size 175

set canvas_relative_x_low -40000
set canvas_relative_y_low -40000
set canvas_relative_x_high 40000
set canvas_relative_y_high 40000

# colors scheme for the windows
set canvas_bg_color black
set hbar_fg_color   black
set hbar_bg_color   grey
set mbar_fg_color   black
set mbar_bg_color   grey
set cbar_fg_color   black
set cbar_bg_color   grey
set obar_fg_color   black
set obar_bg_color   grey
set tbar_fg_color   black
set tbar_bg_color   grey

# color schemes for the domains/patterns/conductors
set default_domain_color white
set default_groove_color maroon4
set default_ridge_color  green
set default_pattern_color grey58

# personalized configurations added -- jcp 3/6/95
if {[file exists ~/.dwmrc] > 0} {source ~/.dwmrc}

# some nice global variables
set run_delay 0
set source_file_ptr  -1
set source_file_name  ""
set state_time 0.0
set time_value 0.0
set state_step 0
set state_counter 0
set skip_index 10

# set this variable to zero if you want to leave a history 
# of the domain wall motion on the screen.
set erase_domains_on_clear 1

# here is a description of the pattern data structure...
# pattern($i,data) {}
# pattern($i,name)  ""
# pattern($i,limits) {}
# pattern($i,description) {}
# pattern($i,in_use)
# pattern($i,display_on) 1
# pattern($i,outline_color)  red
# pattern($i,fill_on) 0
# pattern($i,dcanvas_tag) {}

set number_of_patterns_in_use 0

#set pattern(0,in_use)  0
#set pattern(1,in_use)  0


set domain(0,data) {}
set domain(0,name)  ""
set domain(0,in_use)  0
set domain(0,display_on) 1
set domain(0,color_map)  no
set domain(0,outline_color)  white
set domain(0,fill_on) 0
set domain(0,arrow_on) 0
set domain(0,arrow_color) on
set domain(0,arrow_length) 10
set domain(0,dcanvas_tag) {}
set domain(0,show_time) 1

set domain(1,data) {}
set domain(1,name)  ""
set domain(1,in_use)  0
set domain(1,display_on) 1
set domain(1,color_map)  no
set domain(1,outline_color)  white
set domain(1,fill_on) 0
set domain(1,arrow_on) 0
set domain(1,arrow_color) on
set domain(1,arrow_length) 10
set domain(1,dcanvas_tag) {}
set domain(1,show_time) 1

frame .hbar -relief raised -bd 2 -bg $hbar_bg_color
frame .mbar -relief raised -bd 2 -bg $mbar_bg_color
frame .cbar -relief raised -bd 2 -bg $cbar_bg_color
frame .obar -relief raised -bd 2 -bg $obar_bg_color
frame .tbar -relief raised -bd 2 -bg $tbar_bg_color 
canvas .dcanvas -width ${canvas_physical_x_size}m -height ${canvas_physical_y_size}m -bg $canvas_bg_color

pack .mbar .hbar -side top -fill x
pack .cbar -side right -fill y
pack .obar -side left -fill y
pack .dcanvas -side top
pack .tbar -side bottom -fill x

menubutton .mbar.file    -text File     -bg $mbar_bg_color -menu .mbar.file.menu
menubutton .mbar.options -text Options  -bg $mbar_bg_color -menu .mbar.options.menu
menubutton .mbar.domain  -text Domains  -bg $mbar_bg_color -menu .mbar.domain.menu
menubutton .mbar.pattern -text Patterns -bg $mbar_bg_color -menu .mbar.pattern.menu
menubutton .mbar.help    -text Help     -bg $mbar_bg_color -menu .mbar.help.menu

pack .mbar.file .mbar.options .mbar.domain .mbar.pattern -side left -padx 2m -pady 1m
pack .mbar.help -side right -padx 2m -pady 1m

menu .mbar.file.menu
.mbar.file.menu add command -label "Open" -command { process_open_command }
.mbar.file.menu add command -label "Load Pattern" -command { process_load_pattern_command }
.mbar.file.menu add command -label "Exit" -command exit

menu .mbar.options.menu
.mbar.options.menu add command -label "Option1" -command {puts "option menu test"}

menu .mbar.domain.menu
.mbar.domain.menu    add command -label "View1" -command {puts "view menu test" }

menu .mbar.pattern.menu
.mbar.pattern.menu   add command -label "Colors..." -command { process_pattern_color_command }
#.mbar.pattern.menu   add checkbutton -label "pattern 2" -variable pattern(2,display_on)

menu .mbar.help.menu
.mbar.help.menu   add command -label "Help" -command {puts "help test" }

tk_menuBar .mbar .mbar.file .mbar.options .mbar.view .mbar.help
focus .mbar

# appended by jcp -- 3/6/95 
label .hbar.tlabel1 -text "Time:" -bg $hbar_bg_color
label .hbar.tvalue -textvariable time_value -bg $hbar_bg_color -width 4
label .hbar.tlabel2 -text "ns   " -bg $hbar_bg_color 

label .hbar.space -width 2 -bg $hbar_bg_color

label .hbar.sslabel1 -text "State Step:" -bg $hbar_bg_color
label .hbar.ssvalue -textvariable state_step -bg $hbar_bg_color 

label .hbar.skip_label -text "State Increment: " -bg $hbar_bg_color
entry .hbar.skip_index -textvariable skip_index -bg $hbar_bg_color -width 6 -relief raised

pack .hbar.skip_index .hbar.skip_label -side right -pady 1m -padx 2m 
pack .hbar.tlabel1 .hbar.tvalue .hbar.tlabel2 .hbar.space .hbar.sslabel1 .hbar.ssvalue -side left -pady 1m -padx 0.5m 

button .cbar.run -text Run            -bg $cbar_bg_color -command { run_it }
button .cbar.step -text Step          -bg $cbar_bg_color -command { step_it }
button .cbar.reset -text Reset        -bg $cbar_bg_color -command { reset_it }
button .cbar.zoomin -text "Zoom In"   -bg $cbar_bg_color -command { zoom_in }
button .cbar.zoomout -text "Zoom Out" -bg $cbar_bg_color -command { zoom_out }

button .cbar.tup    -text "Up"    -bg $cbar_bg_color -command { translate_up }
button .cbar.tdown  -text "Down"  -bg $cbar_bg_color -command { translate_down }
button .cbar.tright -text "Right" -bg $cbar_bg_color -command { translate_right }
button .cbar.tleft  -text "Left"  -bg $cbar_bg_color -command { translate_left }

#buttons added by jcp -- future use
button .cbar.pause -text "Pause" 	 	-bg $cbar_bg_color -command {puts "pause test"} 
button .cbar.abort -text "Abort" 	 	-bg $cbar_bg_color -command {puts "abort test"} 
button .cbar.back_step -text "Back Step"	-bg $cbar_bg_color -command {puts "back step test"}

# added 3/9/95 by gp to support hpgl output
button .cbar.hpon -text "HP On"       -bg $cbar_bg_color -command { hpgl_on   }
button .cbar.hpoff -text "HP Off"     -bg $cbar_bg_color -command { hpgl_off  }
button .cbar.hpnext -text "HP Next"   -bg $cbar_bg_color -command { hpgl_next }
button .cbar.hpsave -text "HP Save"   -bg $cbar_bg_color -command { hpgl_save }


pack .cbar.run .cbar.step .cbar.back_step .cbar.reset .cbar.zoomin .cbar.zoomout .cbar.tup .cbar.tdown .cbar.tright .cbar.tleft .cbar.pause .cbar.abort -side top -fill x -pady 2m -padx 2m

pack .cbar.hpsave .cbar.hpnext .cbar.hpoff .cbar.hpon -side bottom -fill x -pady 2m -padx 2m

#text .tbar.msg -relief raised -bd 2 -width 64 -height 2 -bg $tbar_bg_color
#pack .tbar.msg

proc map_x_coordinate { x } {
	global canvas_physical_x_size canvas_physical_y_size
	global canvas_relative_x_low  canvas_relative_y_low 
	global canvas_relative_x_high canvas_relative_y_high

	set result [expr ($x - $canvas_relative_x_low) * $canvas_physical_x_size / ($canvas_relative_x_high - $canvas_relative_x_low) ]	

	return $result
}

proc map_y_coordinate { y } {
	global canvas_physical_x_size canvas_physical_y_size
	global canvas_relative_x_low  canvas_relative_y_low 
	global canvas_relative_x_high canvas_relative_y_high
	set result [expr ($y - $canvas_relative_y_low) * $canvas_physical_y_size / ($canvas_relative_y_high - $canvas_relative_y_low) ]
	set result [expr $canvas_physical_y_size - $result]
	return $result
}


proc draw_list { data color { mode "" } }  {
	set len [llength $data]
	set stop_index [expr $len - 2]
	set p_list ""
	set c_index_list {}
	for { set i 0 } { $i < $stop_index } { incr i 2 } {
		set x1 [lindex $data $i]
		set y1 [lindex $data [expr $i + 1]]
		#set x2 [lindex $data [expr $i + 2]]
		#set y2 [lindex $data [expr $i + 3]]
		set x1 [map_x_coordinate $x1]
		set y1 [map_y_coordinate $y1]
		#set x2 [map_x_coordinate $x2]
		#set y2 [map_y_coordinate $y2]
		#set c_index_list [concat $c_index_list [.dcanvas create line ${x1}m ${y1}m ${x2}m ${y2}m -fill $color]]
		set p_list [concat $p_list ${x1}m ${y1}m]
		}
	# connect the last point to the first
	set x1 [lindex $data 0]
	set y1 [lindex $data 1]
	set x1 [map_x_coordinate $x1]  
	set y1 [map_y_coordinate $y1]
	set p_list [concat $p_list ${x1}m ${y1}m]

	set com_list [concat { .dcanvas create line } $p_list { -fill $color }]
	if { $mode == 1 } {
		set com_list [concat { .dcanvas create polygon } $p_list { -fill $color }]
		}
#	else { set com_list [concat { .dcanvas create line } $p_list { -fill $color }] }

	set c_index_list [eval $com_list]
	return $c_index_list	
}

proc draw_list_2 { data color } {
	set len [llength $data]
	set stop_index [expr $len - 3]
	set c_index_list {}

	for { set i 0 } { $i < $stop_index } { incr i 3 } {
		set x1 [lindex $data $i]
		set y1 [lindex $data [expr $i + 1]]
		set x2 [lindex $data [expr $i + 3]]
		set y2 [lindex $data [expr $i + 4]]
		set x1 [map_x_coordinate $x1]
		set y1 [map_y_coordinate $y1]
		set x2 [map_x_coordinate $x2]
		set y2 [map_y_coordinate $y2]
		set c_index_list [concat $c_index_list [.dcanvas create line ${x1}m ${y1}m ${x2}m ${y2}m -fill $color]]
		}
	# connect the last point to the first
	set x1 [lindex $data [expr $len - 3]]
	set y1 [lindex $data [expr $len - 2]]
	set x2 [lindex $data 0]
	set y2 [lindex $data 1]
	set x1 [map_x_coordinate $x1]
	set y1 [map_y_coordinate $y1]
	set x2 [map_x_coordinate $x2]
	set y2 [map_y_coordinate $y2]
	set c_index_list [concat $c_index_list [.dcanvas create line ${x1}m ${y1}m ${x2}m ${y2}m -fill $color]]
	return $c_index_list	
}

proc draw_list_3 { data color } {
	set len [llength $data]
	set stop_index [expr $len - 3]
	set p_list ""
	set c_index_list {}

	for { set i 0 } { $i < $stop_index } { incr i 3 } {
		set x1 [lindex $data $i]
		set y1 [lindex $data [expr $i + 1]]
		set x1 [map_x_coordinate $x1]
		set y1 [map_y_coordinate $y1]
		set p_list [concat $p_list ${x1}m ${y1}m]
		}
	# connect the last point to the first
	#set x2 [lindex $data 0]
	#set y2 [lindex $data 1]
	#set x2 [map_x_coordinate $x2]
	#set y2 [map_y_coordinate $y2]
	#set p_list [concat $p_list ${x2}m ${y2}m]
	set com_list [concat { .dcanvas create polygon } $p_list { -fill $color }]
	set c_index_list [eval $com_list]
	return $c_index_list
}

proc open_file { filename } {
	global source_file_ptr
	global source_file_name
	set source_file_name $filename
	set source_file_ptr [open $filename]
	}

proc read_object { } {
	global source_file_ptr
	if { $source_file_ptr == -1 } { 
		puts "error I cannot open the file"
		return
		}
	return [ gets $source_file_ptr ]
	}

proc process_groove_object { data } {
	global pattern
	global default_groove_color
	global number_of_patterns_in_use

	set i $number_of_patterns_in_use
	incr number_of_patterns_in_use

	# first set some defaults for safety
	set pattern($i,name)  ""
	set pattern($i,data) {}
	set pattern($i,limits) {}
	set pattern($i,description) {}

	## parse the sentence
	set j 1
	set stop_index [llength $data]
	while { $j != $stop_index } {
		set keyword [lindex $data $j]

		switch $keyword {
			"name" { set pattern($i,name) [lindex $data [expr $j +1]]; incr j  2}

			"data" { set pattern($i,data) [lrange $data [expr $j + 1] end]; break }
			"limits" { set pattern($i,limits) [lrange $data [expr $j+1] [expr $j+4]]; incr j 5 }
			"description" { set pattern($i,description) [lindex $data [expr $j +1]]; incr j 2}
		}
	}
	set pattern($i,in_use) 1
	set pattern($i,display_on) 1
	set pattern($i,outline_color) $default_groove_color
	set pattern($i,fill_on) 1
	set pattern($i,dcanvas_tag) {}
}

proc process_comment_object { data } {
	puts [lrange $data 1 end]
	}

proc process_parameter_object { data } {
	puts -nonewline "PARAMETER: ";
	puts [lrange $data 1 end]
	}


proc process_state { data } {
	global domain state_time state_step time_value
	# current format is: state index time domain domain_name npoints
	set state_step [lindex $data 1]
	set state_time [lindex $data 2]
	set time_value [format "%5.0f" $state_time]
#######This is where time information could be accessed	
	set domain(0,in_use) 1
	set first_element 6
	set last_element [expr $first_element + 3 * [lindex $data 5]]
	set domain(0,data) [lrange $data $first_element $last_element]
	}

proc process_object { data } {
	set obj_type [lindex $data 0]
	switch $obj_type {
		"pattern" { add_pattern [lrange $data 1 end] }
		"manhattangroove" { process_groove_object $data}
		"comment" { process_comment_object $data }
		"parameter" { process_parameter_object $data }
		}
	}


proc add_pattern { data } {
	global pattern
	global default_pattern_color
	global number_of_patterns_in_use

	set i $number_of_patterns_in_use
	incr number_of_patterns_in_use 1

	set pattern($i,name)  ""
	set pattern($i,data) {}
	set pattern($i,limits) {}
	set pattern($i,description) {}

	set pattern($i,data)  $data

	set pattern($i,in_use) 1
	set pattern($i,display_on) 1
	set pattern($i,outline_color) $default_pattern_color
	set pattern($i,fill_on) 1
	set pattern($i,dcanvas_tag) {}
}


proc close_file { } {
	global source_file_name
	global source_file_ptr

	if { $source_file_ptr != -1 } {
	puts "closing the file"
	close $source_file_ptr
	set source_file_ptr -1
	set source_file_name ""
	}
}

proc clear_pattern { pnum } {
	global pattern
	foreach i $pattern($pnum,dcanvas_tag) {
		.dcanvas delete $i
		}
}

proc clear_patterns { } {
	global number_of_patterns_in_use
	set i 0
	for { set i 0 } { $i < $number_of_patterns_in_use } { incr i 1 } {
		clear_pattern $i	
	}
}	

proc clear_domain { dnum } {
	global domain erase_domains_on_clear

	if { $erase_domains_on_clear == 1 } {
		foreach i $domain($dnum,dcanvas_tag) {
			.dcanvas delete $i
			}
		}
}
	
proc clear_domains {} {
	foreach i { 0 1 } {
	clear_domain $i
	}
}	

proc clear_all { } {
	clear_patterns
	clear_domains
	}

proc draw_pattern { pnum } {
	global pattern
	set ilist {}
	# pnum specifies the pattern number to draw
	if { $pattern($pnum,in_use) == 1  && $pattern($pnum,display_on) == 1} {
		set ilist [draw_list $pattern($pnum,data) $pattern($pnum,outline_color) $pattern($pnum,fill_on)]
		set pattern($pnum,dcanvas_tag) $ilist
	}
}

proc draw_patterns { } {
	global number_of_patterns_in_use
	set i 0
	for { set i 0 } { $i < $number_of_patterns_in_use } { incr i 1 } {
		draw_pattern $i
	}
}

proc draw_domain { dnum } {
	global domain
	set ilist {}
	# dnum specifies the domain number to draw
	if { $domain($dnum,in_use) == 1 } {
		set ilist [draw_list_3 $domain($dnum,data) $domain($dnum,outline_color)]
		set domain($dnum,dcanvas_tag) $ilist
	}
}

proc draw_domains { } {
	global domain hpgl_is_on
	foreach i { 0 1 } { 
		draw_domain $i
		}

	# finally, see if we need to save the domains to an hpgl file
	if { $hpgl_is_on == 1 } { write_domains_to_hpgl_file }

}

proc draw_all { } {
	draw_patterns
	draw_domains
	}

proc zoom_out {} {
	global canvas_relative_x_low  canvas_relative_y_low
	global canvas_relative_x_high canvas_relative_y_high

	#clear the drawing area
	clear_all

	#reset the window specs
	set dx  [expr $canvas_relative_x_high - $canvas_relative_x_low]
	set dy  [expr $canvas_relative_y_high - $canvas_relative_y_low]

	set xlow  [expr $canvas_relative_x_low  - 0.5 * $dx]
	set xhigh [expr $canvas_relative_x_high + 0.5 * $dx]

	set ylow  [expr $canvas_relative_y_low  - 0.5 * $dy]
	set yhigh [expr $canvas_relative_y_high + 0.5 * $dy]

	set canvas_relative_x_low $xlow
	set canvas_relative_y_low $ylow
	set canvas_relative_x_high $xhigh
	set canvas_relative_y_high $yhigh

	draw_all
	}

proc zoom_in {} {
	global canvas_relative_x_low  canvas_relative_y_low
	global canvas_relative_x_high canvas_relative_y_high

	#clear the drawing area
	clear_all

	#reset the window specs
	set dx  [expr $canvas_relative_x_high - $canvas_relative_x_low]
	set dy  [expr $canvas_relative_y_high - $canvas_relative_y_low]

	set xlow  [expr $canvas_relative_x_low  + 0.25 * $dx]
	set xhigh [expr $canvas_relative_x_low + 0.75 * $dx]

	set ylow  [expr $canvas_relative_y_low  + 0.25 * $dy]
	set yhigh [expr $canvas_relative_y_low + 0.75 * $dy]

	set canvas_relative_x_low $xlow
	set canvas_relative_y_low $ylow
	set canvas_relative_x_high $xhigh
	set canvas_relative_y_high $yhigh

	draw_all
	}

proc translate_right {} {
	global canvas_relative_x_low  canvas_relative_y_low
	global canvas_relative_x_high canvas_relative_y_high

	#clear the drawing area
	clear_all

	#reset the window specs
	set dx  [expr $canvas_relative_x_high - $canvas_relative_x_low]
	#set dy  [expr $canvas_relative_y_high - $canvas_relative_y_low]

	set xlow  [expr $canvas_relative_x_low  + 0.25 * $dx]
	set xhigh [expr $canvas_relative_x_high + 0.25 * $dx]

	#set ylow  [expr $canvas_relative_y_low  + 0.25 * $dy]
	#set yhigh [expr $canvas_relative_y_low + 0.75 * $dy]

	set canvas_relative_x_low $xlow
	#set canvas_relative_y_low $ylow
	set canvas_relative_x_high $xhigh
	#set canvas_relative_y_high $yhigh

	draw_all
	}

proc translate_left {} {
	global canvas_relative_x_low  canvas_relative_y_low
	global canvas_relative_x_high canvas_relative_y_high

	#clear the drawing area
	clear_all

	#reset the window specs
	set dx  [expr $canvas_relative_x_high - $canvas_relative_x_low]
	#set dy  [expr $canvas_relative_y_high - $canvas_relative_y_low]

	set xlow  [expr $canvas_relative_x_low  - 0.25 * $dx]
	set xhigh [expr $canvas_relative_x_high - 0.25 * $dx]

	#set ylow  [expr $canvas_relative_y_low  + 0.25 * $dy]
	#set yhigh [expr $canvas_relative_y_low + 0.75 * $dy]

	set canvas_relative_x_low $xlow
	#set canvas_relative_y_low $ylow
	set canvas_relative_x_high $xhigh
	#set canvas_relative_y_high $yhigh

	draw_all
	}

proc translate_up {} {
	global canvas_relative_x_low  canvas_relative_y_low
	global canvas_relative_x_high canvas_relative_y_high

	#clear the drawing area
	clear_all

	#reset the window specs
	#set dx  [expr $canvas_relative_x_high - $canvas_relative_x_low]
	set dy  [expr $canvas_relative_y_high - $canvas_relative_y_low]

	#set xlow  [expr $canvas_relative_x_low  + 0.25 * $dx]
	#set xhigh [expr $canvas_relative_x_low + 0.75 * $dx]

	set ylow  [expr $canvas_relative_y_low  + 0.25 * $dy]
	set yhigh [expr $canvas_relative_y_high + 0.25 * $dy]

	#set canvas_relative_x_low $xlow
	set canvas_relative_y_low $ylow
	#set canvas_relative_x_high $xhigh
	set canvas_relative_y_high $yhigh

	draw_all
	}

proc translate_down {} {
	global canvas_relative_x_low  canvas_relative_y_low
	global canvas_relative_x_high canvas_relative_y_high

	#clear the drawing area
	clear_all

	#reset the window specs
	#set dx  [expr $canvas_relative_x_high - $canvas_relative_x_low]
	set dy  [expr $canvas_relative_y_high - $canvas_relative_y_low]

	#set xlow  [expr $canvas_relative_x_low  + 0.25 * $dx]
	#set xhigh [expr $canvas_relative_x_low + 0.75 * $dx]

	set ylow  [expr $canvas_relative_y_low  - 0.25 * $dy]
	set yhigh [expr $canvas_relative_y_high - 0.25 * $dy]

	#set canvas_relative_x_low $xlow
	set canvas_relative_y_low $ylow
	#set canvas_relative_x_high $xhigh
	set canvas_relative_y_high $yhigh

	draw_all
	}

	
	
proc initialize_file { filename } {

	# destroy patterns here
	# destroy domains here
	# close existing file

	open_file $filename
	set data ""
	for { set data [read_object] } { $data != {} && [lindex $data 0] != "state" } { set data [read_object] } {
		# only process non-state objects...
		process_object $data
		}
	
	if { $data == "" } {
		puts "Error: This file does not contain any states."
		draw_all
		return
		}

	# otherwise we have a state. process it, display all and return
	process_state $data
	draw_all
}


proc terminate_file { } {

	destroy_domains 
	destroy_patterns
	close_file 
	}

# Back step_it ##############################################
# proc back_step_it {} {
#	set data [read_object]
#	
#	if { $data == "" } { 
#		puts "end of file"
#		return
#		}
#	if { [lindex $data 0] == "state" } {
#		process_state $data
#		clear_domains
#		draw_domains
#		return
#		}
#	puts "Error: I dont know what to do with what I got"
#	puts $data
#}

proc step_it {} {
	set data [read_object]

	if { $data == "" } {
		puts "end of file"
		return
		}
	if { [lindex $data 0] == "state" } {
		process_state $data
		clear_domains
		draw_domains
		return
		}
	puts "Error: I dont know what to do with what I got"
	puts $data
}


proc run_it {} {
	global state_counter
	global skip_index
	set data ""
	for { set data [read_object] } { $data != "" && [lindex $data 0] == "state" } { set data [read_object] } {
		if { [expr $state_counter % $skip_index] == 0 } {
			process_state $data
			clear_domains
			draw_domains
			update idletasks
			incr state_counter
		} else { incr state_counter }
        }
	puts "Done"
	}

proc reset_it { } {
	global source_file_name 
	global state_counter
	
	if { $source_file_name == ""  } { return }
	set name $source_file_name 
	terminate_file
	initialize_file $name
	set state_counter 0
}
	

proc process_open_command {} {
	set fname [FSBox]
	terminate_file
	initialize_file $fname
	}

#  Changed to a file selecting menu on 3/8/95
#	set fname ""
#	toplevel .gfn
#	label .gfn.label -text "Load File: "
#	entry .gfn.entry -width 32 -relief sunken -textvariable fname
#	pack .gfn.label .gfn.entry -side left -padx 1m -pady 2m
#	bind .gfn.entry <Return> { open_command_utility $fname }

#proc open_command_utility { vname } {
	#
	#
#	destroy .gfn
#	terminate_file
#	initialize_file $vname
#	}
	

proc draw_message { message } {
	puts "$message"
	}


proc destroy_patterns { } {
	global number_of_patterns_in_use
	set i 0
	for { set i 0 } { $i < $number_of_patterns_in_use } { incr i 1 } {
		destroy_pattern $i
	}
	set number_of_patterns_in_use 0
}

proc destroy_pattern { pnum } {
	global pattern

	clear_pattern $pnum

	set pattern($pnum,data) {}
	set pattern($pnum,name)  ""
	set pattern($pnum,in_use)  0
	set pattern($pnum,display_on) 1
	set pattern($pnum,outline_color) {}
	set pattern($pnum,fill_on) 0
	set pattern($pnum,dcanvas_tag) {}
}

proc destroy_domains { } {
	foreach i {0 1 } {
	destroy_domain $i
	}
}

proc destroy_domain { dnum } {
	global domain

	clear_domain $dnum;    # erase it from the screen

	set domain($dnum,data) {}
	set domain($dnum,name)  ""
	set domain($dnum,in_use)  0
	set domain($dnum,display_on) 1
	#set domain($dnum,outline_color)  white
	#set domain($dnum,fill_on) 0
	#set domain($dnum,arrow_on) 0
	#set domain($dnum,arrow_color) on
	#set domain($dnum,arrow_length) 10
	set domain($dnum,dcanvas_tag) {}
}



### code to set the pattern colors...
#proc process_pattern_color_command {} {
#	toplevel .pcolors
#	frame .pcolors.p0 -bd 2 
#	frame .pcolors.p1 -bd 2 
#	frame .pcolors.p2 -bd 2 
#	pack .pcolors.p0 .pcolors.p1 .pcolors.p2 

#	label .pcolors.p0.label -text "Pattern 0:"
#	entry .pcolors.p0.entry -width 32 -relief sunken -textvariable pattern(0,outline_color)

#	label .pcolors.p1.label -text "Pattern 1:"
#	entry .pcolors.p1.entry -width 32 -relief sunken -textvariable pattern(1,outline_color)

#	label .pcolors.p2.label -text "Pattern 2:"
#	entry .pcolors.p2.entry -width 32 -relief sunken -textvariable pattern(2,outline_color)

#	pack .pcolors.p0.label .pcolors.p0.entry -side left -padx 1m -pady 2m
#	pack .pcolors.p1.label .pcolors.p1.entry -side left -padx 1m -pady 2m
#	pack .pcolors.p2.label .pcolors.p2.entry -side left -padx 1m -pady 2m
#	}

proc process_pattern_color_command {} {
	global pattern
	global number_of_patterns_in_use
	toplevel .pcolors

	# first count the number of patterns. store in pc
	set pc $number_of_patterns_in_use

	# create frames for each pattern in use.

	for { set i 0 } { $i < $pc } { incr i 1 } {
		frame .pcolors.p$i -bd 2
		pack .pcolors.p$i	
		}
	# and create an extra frame at the bottom of the window
	# for some buttons.

	frame .pcolors.actions -bd 2
	pack .pcolors.actions
	
	# now fill in the frames with the relevant data...

	for { set i 0 } { $i < $pc } { incr i 1 } {
		label .pcolors.p$i.l0 -text "Pattern $i:  Name "
		label .pcolors.p$i.l1 -relief sunken -width 16 -text $pattern($i,name)
		label .pcolors.p$i.l2 -text "Outline"
		entry .pcolors.p$i.e0 -width 12 -relief sunken -textvariable pattern($i,outline_color)
		checkbutton .pcolors.p$i.c0 -text "Fill  " -variable pattern($i,fill_on)
		checkbutton .pcolors.p$i.c1 -text "Display On" -variable pattern($i,display_on)
		pack .pcolors.p$i.l0 .pcolors.p$i.l1 .pcolors.p$i.l2 .pcolors.p$i.e0 .pcolors.p$i.c0 .pcolors.p$i.c1 -side left -padx 1m -pady 2m
	}

	# finally the button bar at the bottom of the window.


	button .pcolors.actions.apply -text "Apply" -command { clear_all; draw_all; }
	button .pcolors.actions.ok    -text "Ok"    -command { 	clear_all; draw_all; destroy .pcolors }
	pack .pcolors.actions.apply .pcolors.actions.ok -side left -padx 1m -pady 2m
}

proc process_load_pattern_command {} {
	set fname ""
	toplevel .gfn
	label .gfn.label -text "Pattern File: "
	entry .gfn.entry -width 32 -relief sunken -textvariable fname
	pack .gfn.label .gfn.entry -side left -padx 1m -pady 2m
	bind .gfn.entry <Return> { load_pattern_command_utility $fname }
	}

proc load_pattern_command_utility { vname } {
	destroy .gfn
	# open the file...
	terminate_file
	initialize_file $vname
	}


###### HPGL support ########
# the following code is called when the various hp buttons are pressed.

set hpgl_file_pointer 0
set hpgl_index    0
set hpgl_is_initialized 0
set hpgl_is_on 0

proc write_list_to_hpgl_file { data mode } {
	global hpgl_is_initialized hpgl_file_pointer

	if { $hpgl_is_initialized == 0 } { return }

	set len [llength $data]
	set stop_index [expr $len - 2]

	set x1 [lindex $data 0]
	set y1 [lindex $data 1]

	set msg [format "PA %.0f %.0f;SP1;PD;" $x1 $y1]
	puts $hpgl_file_pointer $msg
    	#puts $hpgl_file_pointer "SP1;PD;"

	for { set i 2 } { $i < $stop_index } { incr i 2 } {
		set x1 [lindex $data $i]
		set y1 [lindex $data [expr $i + 1]]
		set msg [format "PA %.0f %.0f;" $x1 $y1]
		puts $hpgl_file_pointer $msg
		#puts $hpgl_file_pointer "PA $x1 $y1;"
		}
	set x1 [lindex $data 0]
	set y1 [lindex $data 1]
	set msg [format "PA %.0f %.0f;PU;SP0;" $x1 $y1]
	puts $hpgl_file_pointer $msg
	#puts $hpgl_file_pointer "PA $x1 $y1;"
	#puts $hpgl_file_pointer "PU;SP0;"
}

proc initialize_hpgl_output {} {
	global hpgl_is_initialized hpgl_file_pointer hpgl_index source_file_name hpgl_index
	global number_of_patterns_in_use pattern

	if { $hpgl_is_initialized == 1 } {
		puts "The hpgl file is alreagy initialized"
		return
		}

	if { $source_file_name == "" } {
		puts "Error: you have not specified an HPGL filename"
		return 0
		}

	set hpgl_file_pointer [open ${source_file_name}.hpgl.$hpgl_index "w"]
	set hpgl_is_initialized 1

	## here is the generic hpgl file initialization

	puts $hpgl_file_pointer "IN;"
	puts $hpgl_file_pointer "SP0;"

	## write the pattern information out here

	set i 0
	for { set i 0 } { $i < $number_of_patterns_in_use } { incr i 1 } {
		write_list_to_hpgl_file $pattern($i,data) 1
	}

	return 1
}

proc terminate_hpgl_output {} {
	global hpgl_is_initialized hpgl_file_pointer

	if { $hpgl_is_initialized == 0 } {
		puts "The hpgl file is not in use."
		return
		}

	close $hpgl_file_pointer
	set hpgl_is_initialized 0
}

proc write_domains_to_hpgl_file {} {
	global hpgl_is_initialized hpgl_is_on
	global domain

	## this code only writes out one domain wall

	if { $hpgl_is_initialized == 1 && $hpgl_is_on == 1 } {

		if { $domain(0,in_use) == 0 } { return }

		set len [llength $domain(0,data)] 
		set stop_index [expr $len - 3]
		set data {}

		for { set i 0 } { $i < $stop_index } { incr i 3 } {
			set x1 [lindex $domain(0,data) $i]
			set y1 [lindex $domain(0,data) [expr $i + 1]]
			set data [concat $data $x1 $y1]
			}
		write_list_to_hpgl_file $data 1
		}
}




proc hpgl_on {} {
	global hpgl_is_on hpgl_is_initialized
	if { $hpgl_is_on == 1 } { return }
	if { $hpgl_is_initialized == 1 } {
		set hpgl_is_on 1
		return
		}

	if { [initialize_hpgl_output] == 0 } {
		# there was an error initializing the hpgl output file
		return
		}
	# all ok. set the variable and return.
	set hpgl_is_on 1
	return 1
}

proc hpgl_off {} {
	global hpgl_is_on
	set hpgl_is_on 0
}

proc hpgl_next {} {
	global hpgl_is_on hpgl_is_initialized
	global hpgl_index
	puts "HPGL NEXT"

	# check to see if the file has been initialized.  if not, just return
	if { $hpgl_is_initialized == 0 } { return }

	# ok. now we really have to do some work

	terminate_hpgl_output
	incr hpgl_index

	if { [initialize_hpgl_output] == 0 } {
		# there was an error initializing the hpgl output file
		set hpgl_is_on 0
		set hpgl_is_initialized 0
		return
		}
	# leave the hpgl_is_on variable alone.
	set hpgl_is_initialized 1
}

proc hpgl_save {} {
	global hpgl_is_initialized
	global domain
	# basically all we need to do here is check to see if 
	# the hpgl files have been initialized (if not, then initialize them)
	# and write out the domain wall info

	if { $hpgl_is_initialized == 0 } {
		if { [initialize_hpgl_output] == 0 } {
			# there was an error initializing the hpgl output file
			return 0
			}
		}

	## this code only writes out one domain wall

	if { $domain(0,in_use) == 0 } { return }

	set rawdata $domain(0,data)
	set len [llength $rawdata] 
	set stop_index [expr $len - 3]
	set data {}

	for { set i 0 } { $i < $stop_index } { incr i 3 } {
		set x1 [lindex $rawdata $i]
		set y1 [lindex $rawdata [expr $i + 1]]
		set data [concat $data $x1 $y1]
		}

	write_list_to_hpgl_file $data 1
}

