======
#!/apacs/bin/wish -f
#
#    layout canvas items in rows and columns with optional lines
#
#   Version 1.1
#   Last Modified: Fri Jan  6 09:27:36 1995 by Bryan M. Kramer
#
#   Author: Bryan M. Kramer     (kramer@ai.toronto.edu)
#
#   Modifications and suggestions due to:
#             Brian Grossman <brian@lance.colostate.edu>
#
#   To Do List:
#            1) straddle
#            
#
#
#   This has been implemented and tested using tcl7.3 and tk3.6.
#   It probably works with tk4.0.
#
#                 Copyright (c) 1995  University of Toronto
# ======================================================================
# Permission to use, copy, modify, and distribute this software and its
# documentation for any non-commercial purpose is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that the copyright notice and warranty disclaimer appear in
# supporting documentation, and that the names of the University of Toronto
# and Bryan M. Kramer not be used in advertising or publicity pertaining to
# distribution of the software without specific, written prior permission.
#
# The University of Toronto and Bryan M. Kramer disclaim all warranties with
# regard to this software, including all implied warranties of merchantability
# and fitness.  In no event shall the University of Toronto or Bryan M. Kramer
# be liable for any special, indirect or consequential
# damages or any damages whatsoever resulting from loss of use, data or
# profits, whether in an action of contract, negligence or other
# tortuous action, arising out of or in connection with the use or
# performance of this software.
#
#
# 
#        USAGE example:
#
#        set table [new_table]
#        pack $table
#        set canvas [table_canvas $table]
#
#        table_col_defaults $table 5 1 5 grey
#        table_row_defaults $table 5 1 5 grey
#        table_col_info $table 1 5 3 5 black right
#        table_row_info $table 1 5 3 5 black
#
#        set i [$canvas create text 10 10 -text "item 1 1"]
#        table_add $table $i 1 1
#        set i [$canvas create text 10 10 -text "item 2 1"]
#        table_add $table $i 2 1
#        set i [$canvas create text 10 10 -text "item 2 2"]
#        table_add $table $i 2 2
#
#        table_layout $table
#
#   NOTE:
#        since canvases can take window items, this can be used to create
#        scrolling tables of buttons, entries etc.!
#
#
#
#
#   new_table [parent [-noscroll]]
#                        - returns a frame containing a canvas and
#                          vertical and horizontal scrollbars
#                        - the returned name is the 'table' identifier
#                          for the other table functions
#                        - -noscroll skips making scrollbars and makes the
#                          canvas big enough to show everything in it and make
#                          table_fix_scroll will recalculate the canvas size
#                          instead of recalculating the scrollregion.
#
#   table_canvas table        - return the canvas on which the table is to be drawn
#                          USE this canvas for creating objects
#
#   USER CAN REDEFINE the ABOVE two functions if other window arrangements are
#   desired
#   THE ONLY CONSTRAINT IS THAT [table_canvas table_id] return a canvas
#   containing
#   all the items that are to be layed out
#
#   table_add table item row col - add an item to the table in position row,col
#                                 - ROW AND COL MUST BE >= 1
#                                 - item is an integer identifying an object in
#                                   the canvas
#
#   table_col_defaults table
#                 [margin1 [rule_width [margin2 [rule_colour [alignment]]]]]
#   table_row_defaults table
#                 [margin1 [rule_width [margin2 [rule_colour [alignment]]]]]
#
#                        - set up default row and column information
#                        - between columns we have <space1, line, space2>
#                          where space1 is margin1 pixels, the line has width
#                          rule_width and space2 is margin2 pixels
#                        - the line is drawn in rule_colour
#                        - alignment specifies how objects are placed into cells
#                          that are bigger than the space they need
#                        - column alignments are one of left, right, or center
#                        - row alignments are one of top, bottom, or center
#
#   table_col_info table col
#                 [margin1 [rule_width [margin2 [rule_colour [alignment]]]]]
#   table_row_info table row
#                 [margin1 [rule_width [margin2 [rule_colour [alignment]]]]]
#
#                        - same as defaults except specifies a specific row or
#                          column
#                        - the rule information is for the line AFTER then nth
#                          row or column
#                        - use 0 to specify the rule_width and margin2 for the
#                          leftmost or topmost line
#
#   table_layout table            - move the objects in the canvas so that rows and
#                              columns accomodate the largest elements, aligning
#                              the rest according to the alignment information
#                              given for the table
#                            - NOTE: can call this at any time, i.e. add new
#                              items and redo layout is no problem
#
#   table_fix_scroll table        - change the scroll region of the canvas to
#                                  accomodate all objects on the canvas
#
#

proc table_add {table item row col} {
    upvar \#0 tables$table x
    set x($row,$col) $item
}

proc table_sizes {table rn rowvector cn colvector} {
    upvar \#0 tables$table a
    upvar $rowvector row_h $rn rows
    upvar $colvector col_w $cn cols
    set rows 0
    set cols 0
    set cv [table_canvas $table]
    foreach key [array names a] {
        set l [split $key ,]
        set x [lindex $l 0]
        if {$x >= $rows} {set rows [expr $x + 1]}
        set y [lindex $l 1]
        if {$y >= $cols} {set cols [expr $y + 1]}
        set box [$cv bbox $a($key)]
        if {$box == ""} {continue}
        set width [expr [lindex $box 2] - [lindex $box 0]]
        set height [expr [lindex $box 3] - [lindex $box 1]]
        if [info exists row_h($x)] {
            if {$row_h($x) < $height} {
                set row_h($x) $height
            }
        } else {
            set row_h($x) $height
        }
        if [info exists col_w($y)] {
            if {$col_w($y) < $width} {
                set col_w($y) $width
            }
        } else {
            set col_w($y) $width
        }
    }
}

if {! [info exists table_num]} {
    set table_num 101
}

proc new_table {{parent "."} args} {
    global table_num
    global table_SB
    set table_SB 1
    foreach f $args {
        switch -- $f {
                -noscroll { set table_SB 0 }
                }
            }
    if {$parent == "."} {
        set fm ".table$table_num"
    } else {
        set fm "$parent.table$table_num"
    }
    incr table_num
    frame $fm
    frame $fm.inside
    set cv [canvas $fm.inside.c]
    pack $cv -side top -expand on -fill both
    if $table_SB {
            $cv configure -yscroll "$fm.scrolly set"
            $cv configure -xscroll "$fm.inside.scrollx set"
            scrollbar $fm.scrolly -command "$cv yview"
            bind $fm.scrolly <FocusIn> { tk_focusContinue %W }
            scrollbar $fm.inside.scrollx -command "$cv xview" -orient horiz
            bind $fm.inside.scrollx <FocusIn> { tk_focusContinue %W }
            pack $fm.inside.scrollx -side bottom -fill x
            pack $fm.scrolly -side right -fill y
            }

    pack $fm.inside -side left -expand on -fill both

    return $fm
}

proc table_canvas {table} {
    return "$table.inside.c"
}

proc table_fix_scroll {table} {
    set cv [table_canvas $table]
    $cv configure -scrollregion [$cv bbox all]
    global table_SB
    if {!$table_SB} {
        set box [$cv bbox all]
        if {$box == ""} {puts stderr "bbox error in table_fix_scroll" }
        $cv configure -height [expr [lindex $box 3] - [lindex $box 1]]
        $cv configure -width [expr [lindex $box 2] - [lindex $box 0]]
        }
}

proc table_margin1 {i infov defv} {
    upvar \#0 $infov info
    if {$i == 0} {
        return 0
    }
    if [info exists info($i,m1)] {
        return $info($i,m1)
    }
    upvar \#0 $defv info
    if [info exists info(m1)] {
        return $info(m1)
    }
    return 0
}

proc table_margin2 {i infov defv} {
    upvar \#0 $infov info
    if [info exists info($i,m2)] {
        return $info($i,m2)
    }
    upvar \#0 $defv info
    if [info exists info(m2)] {
        return $info(m2)
    }
    return 0
}

proc table_rule {i infov defv} {
    upvar \#0 $infov info
    if [info exists info($i,rule)] {
        return $info($i,rule)
    }
    upvar \#0 $defv info
    if [info exists info(rule)] {
        return $info(rule)
    }
    return 0
}

proc table_fill {i infov defv} {
    upvar \#0 $infov info
    if [info exists info($i,fill)] {
        return $info($i,fill)
    }
    upvar \#0 $defv info
    if [info exists info(fill)] {
        return $info(fill)
    }
    return black
}

proc table_just {i infov defv} {
    upvar \#0 $infov info
    if [info exists info($i,just)] {
        return $info($i,just)
    }
    upvar \#0 $defv info
    if [info exists info(just)] {
        return $info(just)
    }
    return left
}

proc table_margin_width {i info def} {
    return [expr [table_margin1 $i $info $def] + [table_margin2 $i $info $def] + [table_rule $i $info $def]]
}



proc table_col_info {table i {m1 0} {rule 0} {m2 0} {fill black} {just left}} {
    upvar \#0 table_col$table col_info
    set col_info($i,m1) $m1
    set col_info($i,m2) $m2
    set col_info($i,rule) $rule
    set col_info($i,fill) $fill
    set col_info($i,just) $just
}

proc table_row_info {table i {m1 0} {rule 0} {m2 0} {fill black} {just top}} {
    upvar \#0 table_row$table row_info
    set row_info($i,m1) $m1
    set row_info($i,m2) $m2
    set row_info($i,rule) $rule
    set row_info($i,fill) $fill
    set row_info($i,just) $just
}



proc table_col_defaults {table {m1 0} {rule 0} {m2 0} {fill black} {just left}} {
    upvar \#0 table_col_def$table col_info
    set col_info(m1) $m1
    set col_info(m2) $m2
    set col_info(rule) $rule
    set col_info(fill) $fill
    set col_info(just) $just
}

proc table_row_defaults {table {m1 0} {rule 0} {m2 0} {fill black} {just top}} {
    upvar \#0 table_row_def$table row_info
    set row_info(m1) $m1
    set row_info(m2) $m2
    set row_info(rule) $rule
    set row_info(fill) $fill
    set row_info(just) $just
}



proc table_draw_rules {table maxx maxy rows rowv cols colv row_info row_defaults col_info col_defaults} {
    upvar $rowv row_h $colv col_w
    set cv [table_canvas $table]
    $cv delete table_rules

    set maxx [expr $maxx - [table_margin2 [expr $rows - 1] $row_info $row_defaults]]
    set maxy [expr $maxy - [table_margin2 [expr $cols - 1] $col_info $col_defaults]]

    set x 0
    for {set j 0} {$j < $cols} {} {
        set x [expr $x + [table_margin1 $j $col_info $col_defaults]]
        set w [table_rule $j $col_info $col_defaults]
        if {$w == 1} {
            set fill [table_fill $j $col_info $col_defaults]
            $cv create line $x 0 $x $maxy -tags table_rules -fill $fill -width $w
        } elseif {$w > 0} {
            set fill [table_fill $j $col_info $col_defaults]
            $cv create rectangle $x 0 [expr $x + $w - 1] $maxy -tags table_rules -fill $fill -outline $fill
        }
        set x [expr $x + $w + [table_margin2 $j $col_info $col_defaults]]
        incr j
        if [info exists col_w($j)] {
            set x [expr $x + $col_w($j)]
        }
    }
    set y 0
    for {set j 0} {$j < $rows} {} {
        set y [expr $y + [table_margin1 $j $row_info $row_defaults]]
        set h [table_rule $j $row_info $row_defaults]
        if {$h == 1} {
            set fill [table_fill $j $row_info $row_defaults]
            $cv create line 0 $y $maxx $y -tags table_rules -fill $fill -width $h

        } elseif {$h > 0} {
            set fill [table_fill $j $row_info $row_defaults]
            $cv create rectangle 0 $y $maxx [expr $y + $h - 1] -tags table_rules -fill $fill -outline $fill
        }
        set y [expr $y + $h + [table_margin2 $j $row_info $row_defaults]]
        incr j
        if [info exists row_h($j)] {
            set y [expr $y + $row_h($j)]
        }
    }
}

proc table_just_x {box j colw col_info col_defaults} {
    set just [table_just $j $col_info $col_defaults]
    if {$just == "left"} {
        return 0
    } elseif {$just == "right"} {
        set w [expr [lindex $box 2] - [lindex $box 0]]
        # must be greater than 0 by construction of column widths
        return [expr $colw - $w]
    } else {
        set w [expr [lindex $box 2] - [lindex $box 0]]
        return [expr ($colw -$w) / 2.0]
    }
}

proc table_just_y {box j rowh row_info row_defaults} {
    set just [table_just $j $row_info $row_defaults]
    if {$just == "top" || $just == "left"} {
        return 0
    } elseif {$just == "bottom" || $just == "right"} {
        set w [expr [lindex $box 3] - [lindex $box 1]]
        # must be greater than 0 by construction of rowumn widths
        return [expr $rowh - $w]
    } else {
        set w [expr [lindex $box 3] - [lindex $box 1]]
        return [expr ($rowh -$w) / 2.0]
    }
}


proc table_layout {table} {
    upvar \#0 tables$table a
    set row_info "table_row$table"
    set col_info "table_col$table"
    set row_defaults "table_row_def$table"
    set col_defaults "table_col_def$table"

    table_sizes $table rows row_h cols col_w
    set cv [table_canvas $table]
    set x [table_margin_width 0 $col_info $col_defaults]

    for {set j 1} {$j < $cols} {incr j} {
        set y [table_margin_width 0 $row_info $row_defaults]
        if [info exists col_w($j)] {
            set w $col_w($j)
        } else {
            set w 0
        }
        for {set i 1} {$i < $rows} {incr i} {
            if [info exists a($i,$j)] {
                set item $a($i,$j)
                set h $row_h($i)
                set box [$cv bbox $item]
                set xx [expr $x + [table_just_x $box $j $w $col_info $col_defaults]]
                set yy [expr $y + [table_just_y $box $i $h $row_info $row_defaults]]
                $cv move $item [expr $xx - [lindex $box 0]] [expr $yy - [lindex $box 1]]
            }
            if [info exists row_h($i)] {
                set y [expr $y + $row_h($i)]
            }
            set y [expr $y + [table_margin_width $i $row_info $row_defaults]]
        }
        if [info exists col_w($j)] {
            set x [expr $x + $col_w($j)]
        }
        set x [expr $x + [table_margin_width $j $col_info $col_defaults]]
    }
    table_draw_rules $table $x $y $rows row_h $cols col_w $row_info $row_defaults $col_info $col_defaults
}



#Local Variables:
#mode: tcl
#End:
======

<<categories>>GUI