##+##########################################################################
#
# GridDebugger.tcl -- Dialog to investigate grid layout
# by Keith Vetter, April 2008
#

package require Tcl 8.5
package require Tk

namespace eval ::GridDebugger {
    variable S                                  ;# Our state
    variable D                                  ;# Display copy
    
    array unset S
    array unset D
    set S(W) .__gaidDialog
    set S(last) ""
    set S(colors) [list red orange yellow green blue cyan purple violet]
    set D(master) "<no master>"
    set D(size) "? x ?"
    image create photo ::img::griddebugger -width 0 -height 0
}
##+##########################################################################
# 
# ::GridDebugger::Dialog -- our debugging dialog
# 
proc ::GridDebugger::Dialog {{master ""}} {
    variable S

    set W $S(W)
    set S(C) $W.c
    destroy $W
    toplevel $W
    wm title $W "Grid Debugger"
    wm protocol $W WM_DELETE_WINDOW ::GridDebugger::Exit
    
    label $W.lm -text "Master:" -anchor e
    $W.lm configure  -font "[font actual [$W.lm cget -font]] -weight bold"
    set font [$W.lm cget -font]
    
    ::ttk::combobox $W.master \
        -state readonly -textvariable ::GridDebugger::D(master) \
        -postcommand ::GridDebugger::PostCommand \
        -width 20
    bind $W.master <<ComboboxSelected>> ::GridDebugger::NewMaster

    label $W.lsize -text "Size:" -anchor e -font $font
    label $W.size -textvariable ::GridDebugger::D(size) -anchor c -font $font
    grid $W.lm $W.master
    grid $W.lsize $W.size -sticky ew

    frame $S(W).f -bd 2 -relief ridge
    canvas $S(C) -width 500 -height 300 -highlightthickness 0
    label $S(W).who -textvariable ::GridDebugger::D(who) -bd 2 -relief ridge \
         -font $font
    pack $S(W).who -in $S(W).f -side bottom -fill x
    pack $S(C) -in $S(W).f -side left -fill both -expand 1
    bind $S(C) <Configure> [list ::GridDebugger::ReCenter %W %h %w]
    ::ttk::button $S(W).exit -text Exit -command ::GridDebugger::Exit
    
    grid $S(W).f - - -sticky news -padx 5
    grid $S(W).exit - - -pady 10
    grid columnconfigure $W 2 -weight 1
    grid rowconfigure $W 2 -weight 1

    ::GridDebugger::NewMaster $master
}
##+##########################################################################
#
# Recenter -- keeps 0,0 at the center of the canvas during resizing
#
proc ::GridDebugger::ReCenter {W h w} {         ;# Called by configure event
    set h2 [expr {$h / 2}] ; set w2 [expr {$w / 2}]
    $W config -scrollregion [list -$w2 -$h2 $w2 $h2]
    ::GridDebugger::Resize
}
##+##########################################################################
# 
# ::GridDebugger::PostCommand -- fills in our combobox with all
# widgets that have gridded slaves
# 
proc ::GridDebugger::PostCommand {args} {
    variable S
    $S(W).master config -values [::GridDebugger::AllGridMasters $S(W)]
}
##+##########################################################################
# 
# ::GridDebugger::GridBbox -- highlights a grid box on master by 'place'ing
# a label on top of it.
# 
proc ::GridDebugger::GridBbox {master row col {clr yellow}} {
    foreach {x y w h} [grid bbox $master $col $row] break
    set top [winfo toplevel $master]
    set tag "$row,$col"
    set W [expr {$top eq "." ? ".__gaid$tag" : "$top.__gaid$tag"}]
    destroy $W
    label $W -image ::img::griddebugger -width $w -height $h -bg $clr
    $W config -padx 0 -pady 0 -bd 0
    place $W -in $master -x $x -y $y -anchor nw
    bind $W <1> [list ::GridDebugger::UnClick $W $row $col]
    return $W
}
##+##########################################################################
# 
# ::GridDebugger::NewMaster -- called when a new master widget is selected
# 
proc ::GridDebugger::NewMaster {{new ""}} {
    variable S
    variable D

    if {$new eq ""} {
        set new $D(master)
    }
    if {! [winfo exists $new]} { ::GridDebugger::Cleanup; return }

    foreach {cols rows} [grid size $new] break
    set this "$new/$rows/$cols"
    if {$this eq $S(last)} return

    ::GridDebugger::Cleanup                     ;# Remove old stuff

    if {$rows == 0 || $cols == 0} {return}

    set D(master) $new
    set S(master) $new
    set D(size) "$rows x $cols"
    ::GridDebugger::Checkerboard $S(C) $rows $cols
    set S(last) $this
}
##+##########################################################################
# 
# ::GridDebugger::Checkerboard -- draws our mockup of the gridded master
# 
proc ::GridDebugger::Checkerboard {c rows cols} {
    $c delete all

    if {[winfo ismapped $c]} {
        set maxX [winfo width $c] ; set maxY [winfo height $c]
    } else {
        set maxX [winfo reqwidth $c] ; set maxY [winfo reqheight $c]
    }

    set dx [expr {($maxX-10) / $cols}]
    set dy [expr {($maxY-10) / $rows}]
    set dx [set dy [expr {min($dx,$dy)}]]

    set row2 [expr {$rows/2.0}]
    set col2 [expr {$cols/2.0}]
    
    for {set row 0} {$row < $rows} {incr row} {
        for {set col 0} {$col < $cols} {incr col} {
            set x0 [expr {($col - $col2) * $dx}]
            set y0 [expr {($row - $row2) * $dy}]
            set x1 [expr {$x0 + $dx}]
            set y1 [expr {$y0 + $dy}]
            set tag cell,$row,$col
            $c create rect $x0 $y0 $x1 $y1 -tag $tag -fill white -outline black
            $c bind $tag <1> [list ::GridDebugger::Click $c $tag]
            $c bind $tag <Enter> [list ::GridDebugger::GetSlaveInfo $row $col]
        }
    }
}
##+##########################################################################
# 
# ::GridDebugger::Resize -- handles resizing the window
# 
proc ::GridDebugger::Resize {} {
    variable S
    set old $S(master)
    ::GridDebugger::Cleanup                     ;# Blow everything away
    ::GridDebugger::NewMaster $old
}
##+##########################################################################
# 
# ::GridDebugger::Click -- called when clicking on a cell in our
# checkerboard. Toggles the cell and toggles highlighting the grid
# cell on the master.
# 
proc ::GridDebugger::Click {C tag} {
    variable S

    if {! [winfo exists $S(master)] || ! [winfo ismapped $S(master)]} {
        ::GridDebugger::Cleanup
        return
    }
    
    foreach {. row col} [split $tag ","] break
    
    set old [$C itemcget $tag -fill]
    if {$old eq "white"} {                      ;# Turn on
        set S(colors) [lassign $S(colors) clr]
        lappend S(colors) $clr
        $C itemconfigure $tag -fill $clr
        set w [::GridDebugger::GridBbox $S(master) $row $col $clr]
        set S(grid,$row,$col) $w
    } else {
        $C itemconfigure $tag -fill white
        destroy $S(grid,$row,$col)
        unset S(grid,$row,$col)
    }
}
##+##########################################################################
# 
# ::GridDebugger::UnClick -- forces a checkerboard cell to be off
# 
proc ::GridDebugger::UnClick {W row col} {
    variable S
    
    destroy $W
    set tag cell,$row,$col
    $S(C) itemconfigure $tag -fill white
    unset S(grid,$row,$col)
}
##+##########################################################################
# 
# ::GridDebugger::AllGridMasters -- returns all widgets w/ gridded slaves
# 
proc ::GridDebugger::AllGridMasters {{exclude ""}} {
    variable S
    set q .
    set all {}

    while {$q ne {}} {
        set q [lassign $q who]
        if {! [winfo ismapped $who]} continue   ;# Not visible
        if {$who in $exclude} continue          ;# Probably our debugger dialog
        lappend q {*}[winfo child $who]
        if {[grid slaves $who] ne {}} {
            lappend all $who
        }
    }
    return $all
}
##+##########################################################################
# 
# ::GridDebugger::Cleanup -- returns everything back to normal
# 
proc ::GridDebugger::Cleanup {} {
    variable S
    variable D

    foreach arr [array names S grid,*] {
        foreach {. row col} [split $arr ","] break
        ::GridDebugger::UnClick $S($arr) $row $col
    }
    $S(C) delete all
    set D(size) "? x ?"
    set D(master) "<no master>"
    set S(master) ""
    set S(last) ""
}
##+##########################################################################
# 
# ::GridDebugger::Exit -- cleans up and exits our dialog
# 
proc ::GridDebugger::Exit {} {
    variable S
    
    ::GridDebugger::Cleanup
    destroy $S(W)
}
##+##########################################################################
# 
# ::GridDebugger::GetSlaveInfo -- displays info about
# the slave at row/col.
# 
proc ::GridDebugger::GetSlaveInfo {row col} {
    variable S
    variable D

    set D(who) [grid slaves $S(master) -row $row -column $col]
    if {$D(who) ne ""} {
        array set info [grid info $D(who)]
        append D(who) " : $info(-rowspan)/$info(-columnspan) $info(-sticky)"
    } else {
        set D(who) "<empty>"
    }
}
################################################################
#
# Demo code
#
toplevel .top
wm geom . +10+10
wm geom .top +300+10
for {set row 0} {$row < 3} {incr row} {
    for {set col 0} {$col < 6} {incr col} {
        set w .l$row$col
        label $w -text "$row,$col" -bd 1 -relief solid -width 5
        grid $w -row $row -column $col
    }
}

label .top.a1 -text "Three columns" -bd 2 -relief ridge
label .top.b1 -text "Three\nrows" -bd 2 -relief ridge
label .top.b2 -text "ABC" -bd 2 -relief ridge
label .top.b3 -text "ABC" -bd 2 -relief ridge
label .top.c3 -text "XYZ" -bd 2 -relief ridge
label .top.d2 -text "MNO" -bd 2 -relief ridge
label .top.d3 -text "MNO" -bd 2 -relief ridge
label .top.e1 -text "Three columns" -bd 2 -relief ridge
grid .top.a1 - - -sticky ew
grid .top.b1 .top.b2 .top.b3 -sticky ns
grid ^ x .top.c3
grid ^ .top.d2 .top.d3
grid .top.e1 - -
::GridDebugger::Dialog .top

return