
# This code is shared by all the ICEM CFD GUI's.
#
# Copyright (c) 1993 - 1995 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

proc futil_bmatrix {w selvar namevar valuevar givenvar keys1 keys2 width height tabgeo select_cmd} {
    global $selvar $namevar $valuevar $givenvar saved_$selvar saved_$valuevar saved_$givenvar
    global futil_bmatrix_varname futil_bmatrix_vvarname futil_bmatrix_gvarname
    global futil_bmatrix_item futil_bmatrix_valitem futil_select_cmd
    
    array set saved_$selvar [array get $selvar]
    array set saved_$valuevar [array get $valuevar]
    array set saved_$givenvar [array get $givenvar]
    set futil_bmatrix_varname($w) $selvar
    set futil_bmatrix_vvarname($w) $valuevar
    set futil_bmatrix_gvarname($w) $givenvar
    set futil_select_cmd $select_cmd
    
    catch {unset futil_bmatrix_valitem}
    
    form_frame $w flat 0 $tabgeo
    
    frame $w.corner
    #label $w.corner.f -text From: ; pack $w.corner.f -side left -anchor sw
    #label $w.corner.t -text To: ; pack $w.corner.t -side right -anchor e
    
    canvas $w.left -yscrollcommand "$w.vs set" -height $height
    canvas $w.top -xscrollcommand "$w.hs set" -width $width
    canvas $w.middle -background white \
	-xscrollcommand "$w.hs set" -width $width \
	-yscrollcommand "$w.vs set" -height $height
    
    scrollbar $w.vs -relief sunken -borderwidth 2 -orient v -command \
	"futil_bmatrix_viewall \"$w.left $w.middle\" yview"
    scrollbar $w.hs -relief sunken -borderwidth 2 -orient h -command \
	"futil_bmatrix_viewall \"$w.top $w.middle\" xview"
    
    blt_table $w $w.corner 0,0
    blt_table $w $w.left 1,0 -fill y
    blt_table $w $w.top 0,1 -fill x
    blt_table $w $w.middle 1,1 -fill both
    blt_table $w $w.vs 1,2 -fill y
    blt_table $w $w.hs 2,1 -fill x
    blt_table_column $w configure 0 -resize none
    blt_table_row $w configure 0 -resize none
    blt_table_column $w configure 2 -resize none
    blt_table_row $w configure 2 -resize none
    
    # Now fill in the stuff.  Kind of a pain to make a uniform grid.
    set maxh 0
    foreach k1 $keys1 {
	set t [set ${namevar}($k1)]
	set i [$w.left create text 0 0 -text $t -anchor nw -tags all]
	set bb [$w.left bbox $i]
	set ih [lindex $bb 3]
	if {$ih > $maxh} { set maxh $ih }
	set left_item($k1) $i
    }
    
    set maxw 0
    foreach k2 $keys2 {
	set t [set ${namevar}($k2)]
	set i [$w.top create text 0 0 -text $t -anchor nw -tags all]
	set bb [$w.left bbox $i]
	set iw [lindex $bb 2]
	if {$iw > $maxw} { set maxw $iw }
	set top_item($k2) $i
    }

    incr maxw; incr maxh
    set y 0
    foreach k1 $keys1 {
	set x 0
	foreach k2 $keys2 {
	    set var "${selvar}($k1 $k2)"
	    set gvar "${givenvar}($k1 $k2)"
	    if ![info exists $var] { set $var 0 }
	    if [info exists $gvar] {
		set col pink
	    } elseif [set $var] {
		set col cyan
	    } else {
		set col white
	    }
	    
	    set vvar "${valuevar}($k1 $k2)"
	    if [info exists $vvar] {
		set txt [set $vvar]
	    } else {
		set txt ""
	    }
	    
	    set i [$w.middle create rectangle [expr $x + 2] [expr $y + 2] \
		       [expr $x + $maxw - 4] [expr $y + $maxh - 4] \
		       -fill $col -tags all]
	    set "futil_bmatrix_item($k1 $k2)" $i
	    
	    set t [$w.middle create text [expr $x + 3] \
		   [expr $y + $maxh / 2] -fill black -tags all -text $txt \
		      -anchor w]
	    set "futil_bmatrix_valitem($k1 $k2)" $t
	    
	    foreach n "$i $t" {
		$w.middle bind $n <1> [list futil_bmatrix_toggle $w.middle \
					   $k1 $k2 $valuevar $selvar $givenvar $i]
		$w.middle bind $n <2> [list futil_bmatrix_edit $w.middle \
					   $k1 $k2 $valuevar $givenvar $t $i]
	    }
	    
	    incr x $maxw
	}
	incr y $maxh
    }
    
    set y 0
    foreach k1 $keys1 {
	$w.left coords $left_item($k1) 0 $y
	incr y $maxh
    }
    set x 0
    foreach k2 $keys2 {
	$w.top coords $top_item($k2) $x 0
	incr x $maxw
    }
    
    $w.top configure -scrollregion [$w.top bbox all]
    $w.left configure -scrollregion [$w.left bbox all]
    $w.middle configure -scrollregion [$w.middle bbox all]
    $w.top configure -height $maxh
    $w.left configure -width $maxw
}

proc futil_bmatrix_viewall {wins view args} {
    foreach w $wins { eval $w $view $args }
}

proc futil_bmatrix_toggle {w k1 k2 valuevar selvar givenvar i} {
    global $valuevar $selvar $givenvar futil_bmatrix_item
    global futil_bmatrix_valitem futil_select_cmd
    
    set it1 [set "futil_bmatrix_item($k1 $k2)"]
    set it1v [set "futil_bmatrix_valitem($k1 $k2)"]
    set vn1 "${selvar}($k1 $k2)"
    if [info exists "futil_bmatrix_item($k2 $k1)"] {
	set it2 [set "futil_bmatrix_item($k2 $k1)"]
	set it2v [set "futil_bmatrix_valitem($k2 $k1)"]
	set vn2 "${selvar}($k2 $k1)"
    } else {
	set vn2 ""
    }
    if [info exists $vn1] {
	set on [set $vn1]
	if $on {
	    set $vn1 0
	    $w itemconfigure $it1 -fill white
	} else {
	    set $vn1 1
	    $w itemconfigure $it1 -fill cyan
	    if {$futil_select_cmd != ""} {
		set v1 [eval [list $futil_select_cmd $k1 $k2]]
		if {$v1 != ""} { $w itemconfigure $it1v -text $v1 }
	    }
	}
	if [info exists $vn2] {
	    if $on {
		set $vn2 0
		$w itemconfigure $it2 -fill white
	    } else {
		set $vn2 1
		$w itemconfigure $it2 -fill cyan
		if {$futil_select_cmd != ""} {
		    set v2 [eval [list $futil_select_cmd $k2 $k1]]
		    if {$v2 != ""} { $w itemconfigure $it2v -text $v2 }
		}
	    }
	}
    }
}

proc futil_bmatrix_edit {w k1 k2 valuevar givenvar t i} {
    global $valuevar $givenvar
    
    set txt [$w itemcget $t -text]
    set txt [question_box .new_value "Form factor" \
		 "Edit the form factor value." $txt]
    if {$txt != ""} {
	$w itemconfigure $t -text $txt
	set "${valuevar}($k1 $k2)" $txt
	set "${givenvar}($k1 $k2)" 1
	$w itemconfigure $i -fill pink
    }
}

proc futil_bmatrix_relabel {w} {
    global futil_bmatrix_vvarname futil_bmatrix_valitem futil_bmatrix_varname 
    global futil_bmatrix_gvarname futil_bmatrix_item
    
    if ![info exists futil_bmatrix_vvarname($w)] return
    
    set var $futil_bmatrix_vvarname($w)
    set gvar $futil_bmatrix_gvarname($w)
    set ovar $futil_bmatrix_varname($w)
    global $var $gvar $ovar
    
    foreach key [array names futil_bmatrix_valitem] {
	set it $futil_bmatrix_valitem($key)
	set box $futil_bmatrix_item($key)
	
	if [info exists ${var}($key)] {
	    set txt [set ${var}($key)]
	} else {
	    set txt ""
	}
	$w.middle itemconfigure $it -text $txt
	
	if [info exists "${gvar}($key)"] {
	    set col pink
	} elseif [set ${ovar}($key)] {
	    set col cyan
	} else {
	    set col white
	}
	$w.middle itemconfigure $box -fill $col
    }
}

proc futil_bmatrix_reset {w} {
    global futil_bmatrix_varname futil_bmatrix_vvarname futil_bmatrix_item
    global futil_bmatrix_gvarname
    
    if ![info exists futil_bmatrix_vvarname($w)] return
    
    set v $futil_bmatrix_varname($w)
    set v2 $futil_bmatrix_vvarname($w)
    set v3 $futil_bmatrix_gvarname($w)
    global $v $v2 $v3 saved_$v saved_$v2 saved_$v3
    
    foreach k [array names futil_bmatrix_item] {
	if [catch {set saved_${v}($k)} on] { set on 0 }
	set ${v}($k) $on
	if [info exists "${v3}($k)"] {
	    set col pink
	} elseif $on {
	    set col cyan
	} else {
	    set col white
	}
	$w.middle itemconfigure $futil_bmatrix_item($k) -fill $col
    }
    foreach k [array names $v2] {
	if [info exists saved_${v2}($k)] {
	    set ${v2}($k) [set saved_${v2}($k)]
	} else {
	    unset ${v2}($k)
	}
    }
}

proc bmatrix_test {} {
    global test_sel test_name test_val
    
    set keys ""; set keys2 All
    set test_name(All) All
    for {set i 0} {$i < 20} {incr i} {
	lappend keys x$i; lappend keys2 x$i
	set test_name(x$i) "random\nx$i"
    }
    catch {unset test_sel}
    catch {unset test_val}
    
    foreach q {"x2 x4" "x3 x5" "x7 x7"} { set test_sel($q) 1 }
    foreach q {"x2 x4" "x3 x5" "x7 x7"} { set test_val($q) .123 }
    
    set w .rad_summary
    set buts [list "Accept \{form_done $w; set form_done_flag($w) 1\}" \
		  "Reset \{futil_bmatrix_reset $w.main.mat\}" \
		  "Cancel \{futil_bmatrix_reset $w.main.mat; \
			form_done $w; set form_done_flag($w) 0\}"]
    
    catch {form_kill $w}
    set d [form_init $w "Radiation object selection" model $buts]
    futil_bmatrix $d.mat test_sel test_name test_val $keys $keys2 400 400 {0 0}
    
    form_finish
    if ![form_wait $w] return
    
    puts "hey hey"
}
