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

proc summary_form {} {
    global summary_active
    global object_type_title_short object_type_list object_type_title
    global summary_show summary_type summary_dest summary_filename
    global summary_object_active special_summary_types summary_from_lib
    global summary_activeb summary_deleteb icepak_root
    
    foreach type "$object_type_list group" {
	if {[db_list_objects $type] != ""} {
	    set summary_active($type) 1
	} else {
	    set summary_active($type) 0
	}
    }
    set d [form_init .summary_form "Object summary" summary]
    if {$d != ""} {
	set summary_type brief
	set summary_dest window
	set summary_filename summary.01
	set summary_from_lib 0
	set summary_activeb 1
	set summary_deleteb 0
	
	set buts ""
	foreach type $object_type_list {
	    lappend buts [list $type $object_type_title_short($type)]
	}
	lappend buts [list group Groups]
	if 0 {
	lappend buts [list job "Project params"]
	lappend buts [list problem "Problem params"]
	lappend buts [list solve "Solution params"]
	}
	form_label $d.lab "Show information for types:" {0 0 -cols -}
	form_frame $d.tt sunken 2 {1 1 -cols -}
	set nb [llength $buts]
	set nr [expr {($nb + 1) / 2}]
	for {set i 0} {$i < $nb} {incr i} {
	    set but [lindex $buts $i]
	    set t [lindex $but 0]
	    set summary_show($t) 1
	    form_checkbutton $d.tt.$t [lindex $but 1] summary_show($t) \
		"[expr {$i % $nr}] [expr {$i / $nr}]" summary_active($t)
	}
	form_colwidth $d 0 4 M
	
	if [info exists icepak_root] {
	    form_checkbutton $d.froml "Include library objects" \
		summary_from_lib {9 0 -cols -}
	}
	
	form_label $d.tlab "Summary type:" {10 0 -cols -}
	form_frame $d.t flat 0 {11 1 -cols -}
	form_radiobutton $d.t.brief Brief summary_type brief {11 1}
	form_radiobutton $d.t.detailed Detailed summary_type detailed {11 2}
	#form_radiobutton $d.t.editable Editable summary_type editable {11 3}
	set c 4
	foreach i [array names special_summary_types] {
	    form_radiobutton $d.t.c$c $i summary_type $i "11 $c"
	    incr c
	}
	
	form_label $d.dlab "Destination:" {20 0 -cols -}
	form_radiobutton $d.dfile File summary_dest file {21 1} \
	    {{summary_type brief detailed}}
	form_radiobutton $d.dwindow Window summary_dest window {21 2}
	
	form_label $d.filel "File:" {22 1} {{summary_dest file}}
	form_frame $d.filef flat 0 {22 2 -cols -}
	futil_fileentry $d.filef.e summary_filename [directory summary] \
	    {0 0} {{summary_dest file}}
	
	form_checkbutton $d.activel "Include active buttons" summary_activeb \
	    {23 1 -cols -} {{summary_dest window}}
	form_checkbutton $d.deletel "Include delete buttons" summary_deleteb \
	    {24 1 -cols -} {{summary_dest window}}
	
	form_finish bot
    }
    
    if ![form_wait .summary_form] return
    
    summary_update
}

proc summary_update {{usewin ""}} {
    global summary_active
    global object_type_title_short object_type_list object_type_title
    global summary_show summary_type summary_dest summary_filename
    global summary_object_active special_summary_types summary_from_lib
    global summary_activeb summary_deleteb fixedfont
    
    set sfont $fixedfont
    
    if {$usewin == "all"} {
	foreach ww [winfo children .] {
	    if {[winfo ismapped $ww] && [scan $ww .summary%d dummy]} {
		summary_update $ww
	    }
	}
	return
    }
    
    if [info exists special_summary_types($summary_type)] {
	$special_summary_types($summary_type)
	return
    }
    
    switch $summary_dest {
	file {
	    set fp [open [directory summary]/$summary_filename w]
	}
	window {
	    if {$usewin == ""} {
		for {set i 1} {[winfo exists .summary$i]} {incr i} {}
		set toplev .summary$i
		set buts [list [list Update "summary_update $toplev"] \
			      [list Done "form_kill $toplev"]]
		set ww [form_init $toplev "Summary \#$i" "summary sub$i" \
			    $buts "" 1 1 1]
		if {$ww == ""} return
		form_frame $ww.fr sunken 2 {0 0}
		form_text $ww.fr.text "" "" {0 0 -cols 2} "" 80x20
		set text $ww.fr.text.text
		$text configure -font $sfont
		$text tag configure title -foreground blue -font $sfont
		$text tag configure name -foreground brown -font $sfont
		
		set d $ww.fr.buts
		form_frame $d flat 0 {1 0}
		form_label $d.type Type: {0 0}
		form_radiobutton $d.br Brief summary_type brief {0 1}
		form_radiobutton $d.dt Detailed summary_type detailed {0 2}
		form_button $d.wf "Write file" summary_write_file {0 3}
		foreach i {br dt} {
		    $d.$i configure -command "summary_update $toplev"
		}
		blt_table_row $ww.fr configure 1 -resize none
	    } else {
		set toplev $usewin
		set text $usewin.main.fr.text.text
		$text delete 1.0 end
	    }
	}
    }
    
    foreach t "$object_type_list group" {
	set doactive [expr {$summary_activeb && \
				([lsearch "group domain" $t] < 0)}]
	set dodelete [expr {$summary_deleteb && \
				([lsearch "group domain" $t] < 0)}]
	
	set objects ""
	foreach obj [db_list_objects $t] {
	    if {!$summary_from_lib && ([$obj getval mat_lib_path ""] != "")} continue
	    lappend objects $obj
	}
	
	if {($objects == "") || !$summary_show($t)} continue
	switch $summary_dest {
	    file {
		puts $fp "$object_type_title($t) ------------\n\n"
	    }
	    window {
		$text insert end "$object_type_title($t) ------------\n" title
		if $doactive {
		    button $text.actall_$t -text "Activate all" \
			-command "summary_actall $t 1" -background white \
			-relief ridge -borderwidth 2 -font $sfont \
			-activebackground \#d0d0d0
		    $text window create end -window $text.actall_$t
		    $text insert end "  "
		    button $text.deactall_$t -text "Deactivate all" \
			-command "summary_actall $t 0" -background white \
			-relief ridge -borderwidth 2 -font $sfont \
			-activebackground \#d0d0d0
		    $text window create end -window $text.deactall_$t
		    $text insert end "  "
		}
		if $dodelete {
		    button $text.deleteall_$t -text "Delete inactive" \
			-command "summary_deleteall_inactive $t $toplev" -background white \
			-relief ridge -borderwidth 2 -font $sfont \
			-activebackground \#d0d0d0
		    $text window create end -window $text.deleteall_$t
		    $text insert end "  "
		}
		$text insert end "\n"
	    }
	}
	set count 0
	foreach obj $objects {
	    if {!$summary_from_lib && ([$obj getval mat_lib_path ""] != "")} continue
	    
	    set summary_object_active($obj) [$obj si_value active]
	    set pref [summary_prefix $obj $summary_type]
	    set desc "..."
	    if {[info commands app_summary_${t}_$summary_type] != ""} {
		# In the case of brief this returns one line.
		# In the case of detailed it returns a list of pairs.
		set desc [app_summary_${t}_$summary_type $obj]
	    }
	    switch $summary_type {
		brief {
		    set output $desc
		}
		detailed {
		    set len 0
		    foreach pair $desc {
			if {[llength $pair] == 2} {
			    set l [string length [lindex $pair 0]]
			    if {$l > $len} { set len $l }
			}
		    }
		    incr len 2
		    set output "\n"
		    set tab 4
		    foreach pair $desc {
			switch [llength $pair] {
			    0 {
				append output "\n"
			    }
			    1 {
				switch [lindex $pair 0] {
				    tab     { incr tab 4 }
				    untab   { incr tab -4 }
				    default {
					set tt [format %${tab}s ""]
					append output "$tt[lindex $pair 0]\n"
				    }
				}
			    }
			    2 {
				set q [lindex $pair 0]
				if {$q != ""} {
				    set tt [format %${tab}s%-${len}s "" "$q ="]
				} else {
				    set tt [format %${tab}s%-${len}s "" ""]
				}
				append output "$tt [lindex $pair 1]\n"
			    }
			}
		    }
		}
	    }
	    switch $summary_dest {
		file {
		    puts $fp "$pref: $output"
		}
		window {
		    if $doactive {
			checkbutton $text.act_${t}$count -text Active \
			    -variable summary_object_active($obj) \
			    -command "summary_actone $obj" -background white \
			    -relief ridge -borderwidth 2 -font $sfont \
			    -activebackground \#d0d0d0
			$text window create end -window $text.act_${t}$count
		    }
		    if $dodelete {
			button $text.del_${t}$count -text Delete \
			    -command "summary_delone $obj $toplev" \
			    -background white \
			    -relief ridge -borderwidth 2 -font $sfont \
			    -activebackground \#d0d0d0
			$text window create end -window $text.del_${t}$count
		    }
		    $text insert end "  $pref: " name "$output\n"
		}
	    }
	    incr count
	}
	switch $summary_dest {
	    file {
		puts $fp ""
	    }
	    window {
		$text insert end "\n"
	    }
	}
    }

    switch $summary_dest {
	file {
	    close $fp
	}
	window {
	    if {$usewin == ""} {
		form_finish bot
	    }
	}
    }
}

proc summary_write_file {} {
    global summary_dest summary_filename hardcopy_print hardcopy_printer
    global env
    
    set summary_dest file
    set d [form_init .summary_hardcopy "Hardcopy creation" ""]
    if {$d != ""} {
	form_frame $d.fr sunken 3 {0 0}; set d $d.fr
	form_label $d.namel "File name" {0 0}
	form_entry $d.name summary_filename string {0 1}
	form_checkbutton $d.print "Send to printer" hardcopy_print \
	    {1 0 -cols 2}
	form_label $d.pname "Printer name" {2 0} hardcopy_print
	form_entry $d.printer hardcopy_printer string {2 1} hardcopy_print
	form_finish bot
    }
    if ![form_wait .summary_hardcopy] return
    
    summary_update
    
    if $hardcopy_print {
	set env(PRINTER) $hardcopy_printer
	set file [directory hardcopy]/$summary_filename
	set cmd [get_print_cmd $file text]
	mess "Sending to printer...\n"
	eval exec $cmd
	mess "Done.\n"
    }
}

proc summary_actone {obj} {
    global summary_object_active
    set act $summary_object_active($obj)
    $obj setval active $act
    make_visible $obj $act
    db_dirty mesh
}

proc summary_actall {type on} {
    global summary_object_active
    
    foreach obj [db_list_objects $type] {
	set summary_object_active($obj) $on
	$obj setval active $on
	make_visible $obj $on
    }
    db_dirty mesh
}

proc summary_deleteall_inactive {type toplev} {
    global summary_object_active
    
    foreach obj [db_list_objects $type] {
	if ![$obj si_value active] {
	    edit_delete 1 $obj
	}
    }
    summary_update $toplev
    db_dirty mesh
    
}

proc summary_delone {obj toplev} {
    edit_delete 1 $obj
    summary_update $toplev
}

proc summary_prefix {obj type} {
    global object_type_title
    
    if {[$obj getval obtype] == "domain"} {
	return $object_type_title(domain)
    } else {
	set act ""; if ![$obj si_value active 1] { set act " (INACTIVE)" }
	return "[$obj getval name]$act"
    }
}

proc summary_shapeinfo {obj type} {
    set brief [expr {$type == "brief"}]
    set info ""
    foreach sh [db_shapes $obj] {
	set shi [$sh summary_info $brief]
	set info [concat $info $shi]
    }
    return $info
}

# This returns a list with two elements: the label and the value.

proc summary_get {obj field {do_coords 1}} {
    global object_params summary_params object_edit_params
    
    set obtype [$obj getval obtype]
    if ![info exists summary_params($obtype,$field)] {
	foreach parm $object_params($obtype) {
	    if [string match \#* $parm] continue
	    # Order of the params is "title name type default"
	    set summary_params($obtype,[lindex $parm 1]) \
		[list [lindex $parm 0] [lindex $parm 2]]
	}
	foreach ind [array names object_edit_params] {
	    if {[lindex [split $ind ,] 0] == $obtype} {
		foreach parm $object_edit_params($ind) {
		    if {[lindex $parm 0] == "button"} continue
		    # Order of the params is "short title varname(name) type"
		    set vnl [lindex $parm 2]
		    regsub -all \\(|\\) $vnl " " vnl
		    if {[lindex $vnl 0] == "model_data"} continue
		    set summary_params($obtype,[lindex $vnl 1]) \
			[list [lindex $parm 1] [lindex $parm 3] $ind]
		}
	    }
	}
    }
    if [info exists summary_params($obtype,$field)] {
	set param $summary_params($obtype,$field)
    } else {
	set allf [join [concat all [lrange [split $field _] 1 end]] _]
	if [info exists summary_params($obtype,$allf)] {
	    set param $summary_params($obtype,$allf)
	} else {
	    puts "Warning: summary params not found for $obtype field $field"
	    set param "$field string"
	}
    }
    set title [lindex $param 0]
    set ftype [lindex $param 1]
    set subspec [lindex $param 2]
    
    if {$subspec == ""} {
	set val [$obj unit_value $field]
    } else {
	set sh [$obj getval [lindex [split $subspec ,] 1]_shape]
	set val [$sh getval $field]
    }
    switch [lindex $ftype 0] {
	int - float - string - prop - nprop {
	}
	coords {
	    if $do_coords {
		switch [lindex $ftype 1] {
		    suffix {
			set known 0
			foreach i {x y z} {
			    set $i [$obj si_value $i[lindex $ftype 2]]
			    if {[set $i] == ""} { set $i ? } else { incr known }
			}
			if $known {
			    set val "($x, $y, $z)"
			} else {
			    set val <unspecified>
			}
		    }
		}
	    }	
	}
	default {
	    foreach ff $ftype {
		if {$val == [lindex $ff 0]} { set val [lindex $ff 1]; break }
	    }
	}
    }
    if {$val == ""} { set val "<unspecified>" }
    return [list $title $val]
}

# This returns a list of pairs.

proc summary_get_initconds {obj} {
    return ""
}
