
# Copyright (c) 2001 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California
#
# Tree viewing stuff.

proc spread_edit {objects show_what} {
    mess "Writing intermediate XML file...\n"
    set file [directory]/spread_tmp.spr
    spread_write $file $objects $show_what
    mess "Done.\n"
}

proc spread_write {file objects show_what} {
    global object_type_title object_params
    
    global got_objects
    catch {unset got_objects}
    
    foreach obj $objects {
	set type [$obj getval obtype]
	set subtypes [db_subtypes $obj 0]
	set subtypes_t [db_subtypes $obj 1]
	
	set shtypes ""
	foreach sh [db_shapes $obj] { lappend shtypes [$sh get -shtype] }
	
	set key [list $type $subtypes $shtypes]
	lappend got_objects($key) $obj
    }
    
    set fp [open $file w]
    
    foreach key [lsort [array names got_objects]] {
	set obtype [lindex $key 0]
	set subtypes [lindex $key 1]
	set subtypes_t [lindex $key 2]
	set shtypes [lindex $key 3]
	set objects $got_objects($key)
	
	set get_opts ""
	
	spread_tag_body $fp SPR_TABLE {
	    set title "$object_type_title($obtype): $subtypes_t, $shtypes"
	    spread_tag_one $fp TITLE $title
	    
	    spread_tag_body $fp COLGROUP {
		spread_tag_one $fp TITLE "Object info"
		
		foreach {name title type} {
		    name Name string
		    active Active boolean
		    groups Groups string
		} {
		    spread_tag_body $fp COL {
			spread_tag_one $fp NAME $name
			spread_tag_one $fp TITLE $title
			spread_tag_one $fp TYPE $type
		    }
		    lappend get_opts $name
		}
	    }
	    spread_tag_body $fp COLGROUP {
		spread_tag_one $fp TITLE "Shape params"
	    }
	    spread_tag_body $fp COLGROUP {
		spread_tag_one $fp TITLE "Thermal/flow params"
		foreach data [spread_object_params $obtype $subtypes \
				  $shtypes] {
		    foreach n {title name type default units choices active} \
			d $data { set $n $d }
		    
		    spread_tag_body $fp COL {
			spread_tag_one $fp NAME $name
			spread_tag_one $fp TITLE $title
			spread_tag_one $fp TYPE $type
			spread_tag_one $fp DEFAULT $default
			if {$choices != ""} {
			    spread_tag_body $fp CHOICES {
				foreach ch $choices {
				    spread_tag_body $fp CHOICE {
					spread_tag_one $fp NAME [lindex $ch 0]
					spread_tag_one $fp TITLE [lindex $ch 1]
				    }
				}
			    }
			}
			if {$active != ""} {
			    spread_tag_body $fp ACTIVE {
			    }
			}
			if {$units != ""} {
			    spread_tag_body $fp UNITS {
				spread_tag_one $fp NAME $units
			    }
			}
			lappend get_opts $name
		    }
		}
	    }
	    foreach obj $objects {
		spread_tag_body $fp ROW {
		    foreach opt $get_opts {
			set vu [$obj get_value_with_units $opt]
			spread_tag_body $fp CELL {
			    spread_tag_one $fp NAME $opt
			    spread_tag_one $fp VALUE [lindex $vu 0]
			    if {[lindex $vu 1] != ""} {
				spread_tag_one $fp UNITS [lindex $vu 1]
			    }
			}
		    }
		}
	    }
	}
    }
    close $fp
}

proc spread_shape_params {obtype subtypes shapetypes} {
    global object_params object_type_params_only
    
    return ""
}

proc spread_object_params {obtype subtypes shapetypes} {
    global object_params object_type_params_only object_type_params_nosummary
    global object_type_params_ignore_this
    
    if ![info exists object_type_params_ignore_this] {
	make_object_type_params_ignore
    }
    
    set params ""
    foreach p $object_params($obtype) {
	if [string match \#* $p] continue
	if {[lindex $p 0] == ""} continue
	if {[info exists object_type_params_nosummary($obtype,[lindex $p 1])] ||
	    [info exists object_type_params_ignore_this($obtype,$subtypes,[lindex $p 1])]} {
	    continue
	}
	set type [lindex $p 2]
	set default [lindex $p 3]
	set units [lindex $p 4]
	set choices ""
	set active ""
	
	switch [lindex $type 0] {
	    string {
		set pch [lindex $p 5]
		if {$pch != ""} {
		    foreach c $pch {
			lappend choices [list $c $c]
		    }
		}
	    }
	    float - int - bool { }
	    mat {
		foreach c [list_materials [lindex $type 1]] {
		    lappend choices [list $c $c]
		}
		set type string
	    }
	    default {
		puts "WARNING: ignored $p"
		continue
	    }
	}
	
	lappend params [list [lindex $p 0] [lindex $p 1] \
			    $type $default $units $choices $active]
    }
    return $params
}

proc spread_tag_body {fp tag body} {
    puts $fp "<$tag>"
    uplevel 1 $body
    puts $fp "</$tag>"
}

proc spread_tag_one {fp tag val} {
    puts $fp "<$tag>"
    puts $fp $val
    puts $fp "</$tag>"
}
