
# The GUI for Autohex.
#
# Copyright (c) 1999 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California

proc summary_sheet {} {
    global summary_var object_type_list summary_from_lib model_container
    global object_type_title object_params summary_var object_edit_info
    global object_type_params_ignore
    global object_type_params_nosummary summary_stypes
    
    if ![info exists object_type_params_ignore] {
	make_object_type_params_ignore
    }
    
    set summary_from_lib 0
    
    set tree ""
    
    catch {unset summary_var}
    
    #group
    foreach t "$object_type_list" {
	set objects ""
	foreach obj [db_list_objects_recursive $t] {
	    if {!$summary_from_lib &&  ([$obj getval mat_lib_path ""] != "")} continue
	    lappend objects $obj
	}
	if {$objects == ""} continue
	
	set params {
	    { label "Name       " name }
	    { bool Active active }
	    sep
	}
	
	# --------------------------------------------------------
	if { $t != "material" } {
	    lappend params { label "Shape type" current_stype }
	}
	
	catch {unset xxx}
	if [llength $object_edit_info($t)] {
	    foreach o $objects  {
		set sname [lindex [$obj getval section_list] 0]
		if {$sname == ""} continue
	        set sh [$o getval ${sname}_shape]
		if {$sh == ""} continue
	        foreach v [$sh list_values nocoords] {
		    switch [lindex $v 0] {
		    	expected_shape - volume_flag - diff_flag continue
		   	default {
			   set sv shape__[lindex $v 0]
			   set summary_var($t,$model_container,$o,$sv) ""
			   set xxx([list entry [lindex $v 0] $sv]) 1
			}
		    }
		}
	    }
	}
	set params [concat $params [array names xxx]]
	
	if [llength $object_edit_info($t)] {
	    foreach o $objects {
		foreach sname [[lindex $o 0] getval section_list] {
		    set sh [$o getval ${sname}_shape]
		    
		    set shape $sh
		    regsub "shape" $shape "" shape
		    regsub -all {[_0123456789]} $shape "" shape
		    set labels ""
		    foreach v [$sh list_values nocoords] {
			switch [lindex $v 0] {
			    expected_shape - volume_flag - diff_flag continue
			    default {
				set sv shape__[lindex $v 0]
				#if ![info exists shape_set($t,$shape,$sv)] ??
				set shape_set($t,$shape,$sv) 1
				lappend labels \
				    [list entry [lindex $v 0] $sv]
			    }
			}
		    }
		    lappend labels sep
		    if {[info exists summary_stypes($t,$shape)] &&
			([llength $summary_stypes($t,$shape)] >
			 [llength $labels])} {
			set labels $summary_stypes($t,$shape)
		    }
		    set shape_set($t,$shape,sep) 1
		    set summary_stypes($t,$shape) $labels
		    set summary_stypes($t,none) "" ;# XXXX
		}
	    }
	}
        if { $t != "material" } {
	    lappend params sep
	}
	
	# --------------------------------------------------------	
	
	foreach p {name active current_stype} {
	    foreach o $objects {
		set summary_var($t,$model_container,$o,$p) ""
	    }
	}
	foreach p $object_params($t) {
	    if [string match \#* $p] continue
	    if {[lindex $p 0] == ""} continue
	    if [info exists object_type_params_nosummary($t,[lindex $p 1])] continue
	    
	    set type [lindex $p 2]
	    set choices [lindex $p 5]
	    if {($type == "string") && ($choices != "")} {
		set chs ""
		foreach c $choices {
		    lappend chs [list $c $c]
		}
		set pp [list choice [lindex $p 0] [lindex $p 1] $chs]
		
	    } elseif {$type == "bool"} {
		set pp [list bool [lindex $p 0] [lindex $p 1]]
		
	    } else {
		set pp [list entry [lindex $p 0] [lindex $p 1]]
	    }
	    lappend params $pp
	    foreach o $objects {
		set summary_var($t,$model_container,$o,[lindex $p 1]) ""
	    }
	}
	set branch [list $object_type_title($t) $t $model_container $params]
	lappend tree $branch
    }
    if 0 {
    foreach t "group" {
	set objects ""
	foreach obj [db_list_objects $t] {
	    if {!$summary_from_lib && [$obj getval from_library 0]} continue
	    lappend objects $obj
	}
	if {$objects == ""} continue
	
	set params {
	    { label "Name       " name }
	    { label "Members    " members }
	}
	
	foreach o $objects {
	    set summary_var($t,$model_container,$o,name) [$o getval name]
	    set summary_var($t,$model_container,$o,members) ""
	    foreach mem [$o list_contents] {
		append summary_var($t,$model_container,$o,members) \
		    "[$mem getval name]\n"
	    }
	}
	set branch [list $object_type_title($t) $t $model_container $params]
	lappend tree $branch
    }
    }
    spreadsheet .spreadsheet "Parameter summary" $tree summary_get_rows \
	summary_var summary_apply_func summary_reset_func summary_delete_func
}

proc summary_get_rows {name handle} {
    set objs ""
    foreach obj [db_list_objects_recursive $name $handle] {
	if {[$obj getval mat_lib_path ""] == ""} { lappend objs $obj }
    }
    return $objs
}

proc summary_apply_func {var} {
    summary_transfer_func $var 1
    edit_reset_params
}

proc summary_reset_func {var} {
    summary_transfer_func $var 0
}

proc summary_transfer_func {var to_obj} {
    global summary_var
    
    set too_large "** value too large to display **"
    set max_val_size 10000
    
    # copy all the stuff from summary_var to the objects
    foreach key [array names summary_var] {
	set skey [split $key ,]
	set obj [lindex $skey 2]
	set var [lindex $skey 3]
	if [string match shape__* $var] {
	    set var [string range $var 7 end]
	    set sname [lindex [$obj getval section_list] 0]
	    if {$sname == ""} continue
	    set sh [$obj getval ${sname}_shape]

	    if $to_obj {
		set val $summary_var($key)
		set val1 [string trim [lindex [split $val ()] 0]]
 		if {$val1 != $too_large} {
 		    regsub -all \\{ $val1 ( val1
		    regsub -all \\} $val1 ) val1
 		    set un1 [string trim [lindex [split $val ()] 1]]
 		    if [catch {$sh set_value_with_units $var $val1 $un1} res] {
 			puts "can't set $var to $val1 $un1 in $sh ([[$sh get -object] getval name])"
 		    }
		}
	    } else {
		if [catch {$sh get_value_with_units $var} uv] {
		    puts "can't get $var from $sh ([[$sh get -object] getval name])"
		    set uv ""
		}
		set val ""
		if { $uv != "" } {
		    set val [lindex $uv 0]
 		    if {[string length $val] > $max_val_size} {
 			set val $too_large
 		    }
 		    regsub -all \\( $val \{ val
 				    regsub -all \\) $val \} val
 		    if {[lindex $uv 1] != ""} {
 			append val " ([lindex $uv 1])"
		    }
		}
		set summary_var($key) $val
	    }
	} else {
	    if $to_obj {
		if {([$obj getval obtype] == "domain") && ($var == "active")} {
		    # special case
		    continue
		}
		set val $summary_var($key)
		if {$val == "ambient"} {
		    $obj setval $var $val
		} else {
		    set val1 [string trim [lindex [split $val ()] 0]]
		    if {$val1 != $too_large} {
 			regsub -all \\{ $val1 ( val1
			regsub -all \\} $val1 ) val1
 			
 			set un1 [string trim [lindex [split $val ()] 1]]
 			if [catch {$obj set_value_with_units $var $val1 $un1} res] {
 			    puts "can't set $var to $val1 $un1 in $obj ([$obj getval name])"
 			}
 			if {$var == "active"} {
 			    make_visible $obj $val
 			    if {$val != [$obj si_value active]} { db_dirty mesh }
 			}
		    }
		}
		
	    } else {
		if ![$obj checkval $var] {
		    set summary_var($key) ""
		} else {
		    if [catch {$obj get_value_with_units $var} uv] {
			puts "can't get $var from $obj ([$obj getval name])"
			set uv ""
		    }
		    set val [lindex $uv 0]
		    regsub -all \\( $val \{ val
		    regsub -all \\) $val \} val
		    if {[lindex $uv 1] != ""} {
			append val " ([lindex $uv 1])"
		    }
 		    if {[string length $val] > $max_val_size} {
 			set val $too_large
 		    }
		    set summary_var($key) $val
		}
	    }
	}
    }
    if $to_obj { db_dirty model }
}

proc summary_delete_func {obj} {
    edit_delete 1 $obj
    return 1
}
