#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Frame.tcl,v $
# $Date: 2001/07/10 15:36:10 $
# $Revision: 1.18.1.4 $
#
package provide zircon 1.18
#
proc switchFrame {ctl net title col args} {
    global zDIOff
    set rq [llength [grid slaves $ctl -column 0]]
    if {$col > 0} {
        incr rq -1
    } {
        grid rowconfigure $ctl $rq -weight 1 -minsize 30
    }
    grid columnconfigure $ctl $col -weight 1
    grid [set mn [frame $ctl.$net -borderwidth 0]] -sticky nsew \
      -row $rq -column $col
#    switch {} $args {} default {
#	update idletasks
#	set h [frame $mn.h$net -bg blue -borderwidth 4]
#	place $h -relx 1.0 -x -5 -width 5 -height 5 -y 2
#	bindtags $h DragHandle
#    }
    grid columnconfigure $mn 0 -weight 1
    grid rowconfigure $mn 2 -weight 1
    addSeparator $mn -row 0 -column 0
    grid [set f [frame $mn.exp -borderwidth 0]] -sticky ew -row 1 -column 0
    grid columnconfigure $f 1 -weight 1
    grid [button $f.ctl -image $zDIOff -command "exposeFrame $ctl $net"] -row 0 -column 0
    grid [label $f.title -text $title] -row 0 -column 1 -sticky ew
    return [frame $mn.bdy -borderwidth 0]
}
#
proc checkHeight {unusedw} {
    return
#    update idletasks
#    set ht [winfo reqheight $w]
#    if {$ht != [set nh [winfo height $w]]} {
#	wm geometry $w [winfo width $w]x$ht
#    }
}
#
proc exposeFrame {ctl net} {
    global zDIOff zDIOn zDIOff1 zDIOn1
    set w $ctl.$net.exp
    set forget 1
    switch [$w.ctl cget -image] \
      $zDIOff	{set im $zDIOn ; set forget 0} \
      $zDIOff1	{set im $zDIOn1 ; set forget 0} \
      $zDIOn	{set im $zDIOff } \
      $zDIOn1	{set im $zDIOff1 }
    $w.ctl configure -image $im
    if {$forget} {
	grid forget $ctl.$net.bdy
    } {
	grid $ctl.$net.bdy -sticky nsew -row 2 -column 0
    }
}
#
proc openFrame {ctl obj net} {
    global zDIOff zDIOn zDIOff1 zDIOn1
    set w $ctl.$obj.exp
    set forget 1
    $w.ctl configure -image $zDIOn1
    $w.title configure -fg [$net activefg] -bg [$net activebg]
    grid $ctl.$obj.bdy -sticky nsew -row 2 -column 0
}
#
proc closeFrame {ctl obj net} {
    global zDIOff zDIOn zDIOff1 zDIOn1
    set w $ctl.$obj.exp
    set forget 1
    $w.ctl configure -image $zDIOff
    $w.title configure -fg [$net passivefg] -bg [$net passivebg]
    grid forget $ctl.$obj.bdy
}
#
proc hilightFrame {ctl obj net} {
    $ctl.$obj.exp.title configure -fg [$net activefg] -bg [$net activebg]
}
#
proc lolightFrame {ctl obj net} {
    $ctl.$obj.exp.title configure -fg [$net passivefg] -bg [$net passivebg]
}
#
proc retitleFrame {ctl obj title net args} {
    global zDIOff1 zDIOff zDIOn zDIOn1
    append ctl .$obj.exp
    set im [$ctl.ctl cget -image]
    set fg black
    switch {} $args {} default {
	switch [$ctl.ctl cget -image] \
	  $zDIOff	{set im $zDIOff1 ; set fg [$net activefg] ; set bg [$net activebg]} \
	  $zDIOff1	{set im $zDIOff ; set fg [$net passivefg] ; set bg [$net passivebg]} \
	  $zDIOn	{set im $zDIOn1 ; set fg [$net activefg] ; set bg [$net activebg]} \
	  $zDIOn1	{set im $zDIOn ; set fg [$net passivefg] ; set bg [$net passivebg]}
    }
    $ctl.ctl configure -image $im
    $ctl.title configure -text $title -fg $fg -bg $bg
}
#
proc hideFrame {ctl net} { 
    foreach x [winfo children $ctl.$net] {
	switch -glob $x *.bdy {} default {grid forget $x}
    }
}
#
proc deleteFrame {ctl net} {
    array set ginf [grid info $ctl.$net]
    destroy $ctl.$net
    minRow $ctl $ginf(-row)
#    shuffleFrame $ctl
}
#
proc shuffleFrame {ctl} {
    foreach {cols rows} [grid size $ctl] break
    foreach w [grid slaves $ctl] {
        array set ginf [grid info $w]
	set occ($ginf(-row),$ginf(-column)) $w
    }
    set mvd 1
    set rws [expr {$rows -1}]
    while {$mvd} {
        set mvd 0
        for {set c 0} {$c < $cols} {incr c} {
	    for {set r 0} {$r < $rws} {incr r} {
	        set r1 [expr {$r + 1}]
	        if {![info exists occ($r,$c)] && [info exists occ($r1,$c)]} {
		    moveFrame $occ($r1,$c) $r $c
		    set occ($r,$c) $occ($r1,$c)
		    unset occ($r1,$c)
		    set mvd 1
		}
	    }
	}
    }
    set mvd 1
    set cls [expr {$cols -1}]
    while {$mvd} {
        set mvd 0
        for {set r 0} {$r < $rows} {incr r} {
	    for {set c 0} {$c < $cls} {incr c} {
	        set c1 [expr {$c + 1}]
	        if {![info exists occ($r,$c)] && [info exists occ($r,$c1)]} {
		    moveFrame $occ($r,$c1) $r $c
		    set occ($r,$c) $occ($r,$c1)
		    unset occ($r,$c1)
		    set mvd 1
		}
	    }
	}
    }
}
#
proc minRow {ctl row} {
     foreach x [grid slaves $ctl] {
         array set sinf [grid info $x]
	 if {$sinf(-row) == $row} return
     }
     grid rowconfigure $ctl $row -weight 0 -minsize 0
}
#
proc moveFrame {w row col} {
     array set ginf [grid info $w]
     grid remove $w
     minRow [winfo parent $w] $ginf(-row)
     set ginf(-row) $row
     set ginf(-column) $col
     eval grid $w [array get ginf] 
}