# $Id: panner.tcl,v 2.7 2002/05/30 17:11:45 jfontain Exp $


class panner {
    set (default,HandleSize) 8
}

proc panner::panner {this parentPath args} composite {[new frame $parentPath] $args} {
    set ($this,handles) {}
    set ($this,lastManagerSize) 0
    set ($this,handleSize) $(default,HandleSize)
    composite::complete $this
}

proc panner::~panner {this} {}

proc panner::options {this} {
    # force default orientation so that children are managed geometry wise
    # force panes number for initial configuration
    return [list\
        [list -handlesize $(default,HandleSize)]\
        [list -handleplacement 0.9 0.9]\
        [list -orient vertical]\
        [list -panes 2 3]\
    ]
}

proc panner::try {this option value} {
    set path $widget::($this,path)
    catch {$path configure $option $value}
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    for {set itemIndex 0} {$itemIndex<=$lastIndex} {incr itemIndex} {
        set frame $path.$itemIndex
        catch {$frame configure $option $value}
        if {($itemIndex%2)!=0} {                                                                                        ;# separator
            catch {$frame.separator configure $option $value}
            catch {$frame.handle configure $option $value}
        }
    }
}
proc panner::set-handlesize {this value} {
    # always convert to pixels for easier use and error checking and make sure value is even
    set ($this,handleSize) [expr {(([winfo pixels $widget::($this,path) $value]+1)/2)*2}]
    if {$composite::($this,complete)} {
        updateHandleSize $this                                                            ;# cannot update handles before they exist
    }
}

proc panner::set-orient {this value} {
    if {$composite::($this,complete)} {
        error {option -orient cannot be set dynamically}
    }
    if {([string first $value vertical]!=0)&&([string first $value horizontal]!=0)} {
        error "bad orientation value \"$value\": must be horizontal or vertical (or any abbreviation)"
    }
    if {[string match v* $composite::($this,-orient)]} {
        bind $widget::($this,path) <Configure> "panner::resize $this %h"
    } else {
        bind $widget::($this,path) <Configure> "panner::resize $this %w"
    }
}

proc panner::set-panes {this value} {
    if {$composite::($this,complete)} {
        error {option -panes cannot be set dynamically}
    }
    set path $widget::($this,path)
    if {[string match v* $composite::($this,-orient)]} {                                                     ;# vertical arrangement
        set vertical 1
        grid columnconfigure $path 0 -weight 1
        set sticky ew
        set cursor sb_v_double_arrow
    } else {                                                                                               ;# horizontal arrangement
        set vertical 0
        grid rowconfigure $path 0 -weight 1
        set sticky ns
        set cursor sb_h_double_arrow
    }
    set paneIndex 0
    set itemIndex 0
    while {1} {
        set frame [frame $path.$itemIndex]
        if {$vertical} {
            grid $frame -sticky nsew -row $itemIndex -column 0
            grid rowconfigure $path $itemIndex -weight 1000000                                 ;### should be 1, grid bug workaround
        } else {
            grid $frame -sticky nsew -column $itemIndex -row 0
            grid columnconfigure $path $itemIndex -weight 1000000                              ;### should be 1, grid bug workaround
        }
        incr paneIndex                                                                      ;# frame numbers start at 1 for the user
        set ($this,frame$paneIndex) $frame
        if {$paneIndex==$value} {
            break
        }
        incr itemIndex
        set frame [frame $path.$itemIndex]
        if {$vertical} {
            grid $frame -sticky $sticky -row $itemIndex -column 0
            grid rowconfigure $path $itemIndex -weight 1                           ;### should not be necessary, grid bug workaround
        } else {
            grid $frame -sticky $sticky -column $itemIndex -row 0
            grid columnconfigure $path $itemIndex -weight 1                        ;### should not be necessary, grid bug workaround
        }
        frame $frame.separator -borderwidth 1 -relief ridge
        if {$vertical} {
            $frame.separator configure -height 2
        } else {
            $frame.separator configure -width 2
        }
        place $frame.separator -anchor center -relx 0.5 -rely 0.5
        if {$vertical} {
            place $frame.separator -relwidth 1
        } else {
            place $frame.separator -relheight 1
        }
        button $frame.handle -borderwidth 1 -highlightthickness 0 -cursor $cursor -takefocus 0
        bind $frame.handle <ButtonPress-1> "panner::startMotion $this %W"
        if {$vertical} {
            bind $frame.handle <ButtonRelease-1> "panner::endMotion $this %W $itemIndex %Y"
            place $frame.handle -rely 0.5 -anchor center
        } else {
            bind $frame.handle <ButtonRelease-1> "panner::endMotion $this %W $itemIndex %X"
            place $frame.handle -relx 0.5 -anchor center
        }
        incr itemIndex
    }
    updateHandleSize $this
    set-handleplacement $this $composite::($this,-handleplacement)
}

proc panner::set-handleplacement {this value} {
    set path $widget::($this,path)
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    if {[string first $composite::($this,-orient) vertical]==0} {
        for {set itemIndex 1} {$itemIndex<=$lastIndex} {incr itemIndex 2} {
            place $path.$itemIndex.handle -relx $value
        }
    } else {
        for {set itemIndex 1} {$itemIndex<=$lastIndex} {incr itemIndex 2} {
            place $path.$itemIndex.handle -rely $value
        }
    }
}

proc panner::startMotion {this handle} {
    # grab is unnecessary as it is activated and released automatically when using a button
    set path $widget::($this,path)
    if {[string first $composite::($this,-orient) vertical]==0} {                                            ;# vertical arrangement
        bind $handle <Motion> "panner::verticalMotion $this %Y"
        set (line) [frame $path.line -background black -height 1 -width [winfo width $path]]
        set (minimum) [winfo rooty $path]
        set (maximum) [expr {$(minimum)+[winfo height $path]-1}]
    } else {                                                                                               ;# horizontal arrangement
        bind $handle <Motion> "panner::horizontalMotion $this %X"
        set (line) [frame $path.line -background black -width 1 -height [winfo height $path]]
        set (minimum) [winfo rootx $path]
        set (maximum) [expr {$(minimum)+[winfo width $path]-1}]
    }
}

proc panner::clip {coordinate} {
    if {$coordinate<$(minimum)} {
        return $(minimum)
    } elseif {$coordinate>$(maximum)} {
        return $(maximum)
    } else {
        return $coordinate
    }
}

proc panner::endMotion {this handle row rootCoordinate} {
    set visible [expr {[llength [place info $(line)]]>0}]
    destroy $(line)
    bind $handle <Motion> {}
    if {$visible} {                                                                                 ;# only if line has been visible
        split $this $row [expr {[clip $rootCoordinate]-$(minimum)}]
    }
    unset (line) (minimum) (maximum)
}

proc panner::verticalMotion {this yRoot} {
    place $(line) -y [expr {[clip $yRoot]-$(minimum)}]
}

proc panner::horizontalMotion {this xRoot} {
    place $(line) -x [expr {[clip $xRoot]-$(minimum)}]
}

proc panner::split {this handleIndex coordinate} {
    # coordinate is the separator axis one, handle index can be a row or column index depending on the orientation
    if {[string match v* $composite::($this,-orient)]} {                                                     ;# vertical arrangement
        set vertical 1
        set itemName row
        set sizeName height
    } else {                                                                                               ;# horizontal arrangement
        set vertical 0
        set itemName column
        set sizeName width
    }
    set path $widget::($this,path)
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    if {[grid propagate $path]} {                                                                          ;# first user interaction
        grid propagate $path 0                                    ;# stop propagation otherwise enclosing widget would resize larger
        for {set itemIndex 0} {$itemIndex<=$lastIndex} {incr itemIndex} {                 ;# initialize minimum sizes for all frames
            grid ${itemName}configure $path $itemIndex -minsize [winfo $sizeName $path.$itemIndex]
        }
    }
    set separatorsSize 0
    set framesSize 0
    set beforeIndex [expr {$handleIndex-1}]
    set afterIndex [expr {$handleIndex+1}]
    if {$vertical} {
        set lastCoordinate [lindex [grid bbox $path 0 $handleIndex] 1]
        set masterSize [lindex [grid bbox $path] 3]
        set frameStart [lindex [grid bbox $path 0 $beforeIndex] 1]
        set box [grid bbox $path 0 $afterIndex]
        set frameEnd [expr {[lindex $box 1]+[lindex $box 3]}]
    } else {
        set lastCoordinate [lindex [grid bbox $path $handleIndex 0] 0]
        set masterSize [lindex [grid bbox $path] 2]
        set frameStart [lindex [grid bbox $path $beforeIndex 0] 0]
        set box [grid bbox $path $afterIndex 0]
        set frameEnd [expr {[lindex $box 0]+[lindex $box 2]}]
    }
    if {$coordinate>$lastCoordinate} {                                                                ;# grow frame before separator
        incr coordinate -[expr {$($this,handleSize)/2}]                              ;# set coordinate to the resized frame boundary
        for {set itemIndex $handleIndex} {$itemIndex<=$lastIndex} {incr itemIndex} {
            if {($itemIndex%2)==0} {
                incr framesSize [grid ${itemName}configure $path $itemIndex -minsize]
            } else {
                incr separatorsSize $($this,handleSize)
            }
        }
        set remaining [expr {$masterSize-$coordinate-$separatorsSize}]
        if {$remaining<0} {
            set size [expr {$masterSize-$frameStart-$separatorsSize}]
            set remaining 0
        } else {
            set size [expr {$coordinate-$frameStart}]
        }
        grid ${itemName}configure $path $beforeIndex -minsize $size
        for {set itemIndex $lastIndex} {$itemIndex>=$afterIndex} {incr itemIndex -2} { ;# push other frames from nearest to farthest
            if {$remaining>[grid ${itemName}configure $path $itemIndex -minsize]} {
                incr remaining -[grid ${itemName}configure $path $itemIndex -minsize]
            } elseif {$remaining>0} {
                grid ${itemName}configure $path $itemIndex -minsize $remaining
                set remaining 0
            } else {
                grid ${itemName}configure $path $itemIndex -minsize 0
            }
        }
    } elseif {$coordinate<$lastCoordinate} {                                                           ;# grow frame after separator
        incr coordinate [expr {$($this,handleSize)/2}]                               ;# set coordinate to the resized frame boundary
        for {set itemIndex $handleIndex} {$itemIndex>=0} {incr itemIndex -1} {
            if {($itemIndex%2)==0} {
                incr framesSize [grid ${itemName}configure $path $itemIndex -minsize]
            } else {
                incr separatorsSize $($this,handleSize)
            }
        }
        set remaining [expr {$coordinate-$separatorsSize}]
        if {$remaining<0} {
            set size [expr {$frameEnd-$separatorsSize}]                                            ;# leave one pixel for each frame
            set remaining 0
        } else {
            set size [expr {$frameEnd-$coordinate}]
        }
        grid ${itemName}configure $path $afterIndex -minsize $size
        for {set itemIndex 0} {$itemIndex<=$beforeIndex} {incr itemIndex 2} {          ;# push other frames from nearest to farthest
            if {$remaining>[grid ${itemName}configure $path $itemIndex -minsize]} {
                incr remaining -[grid ${itemName}configure $path $itemIndex -minsize]
            } elseif {$remaining>0} {
                grid ${itemName}configure $path $itemIndex -minsize $remaining
                set remaining 0
            } else {
                grid ${itemName}configure $path $itemIndex -minsize 0
            }
        }
    }
}

proc panner::updateHandleSize {this} {
    set size $($this,handleSize)
    set path $widget::($this,path)
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    if {[string match v* $composite::($this,-orient)]} {
        for {set row 1} {$row<$lastIndex} {incr row 2} {
            set frame $path.$row
            place $frame.handle -width $size -height $size
            $frame configure -height $size
            grid rowconfigure $path $row -minsize $size                            ;### should not be necessary, grid bug workaround
        }
    } else {
        for {set column 1} {$column<$lastIndex} {incr column 2} {
            set frame $path.$column
            place $frame.handle -width $size -height $size
            $frame configure -width $size
            grid columnconfigure $path $column -minsize $size                      ;### should not be necessary, grid bug workaround
        }
    }
}

proc panner::resize {this size} {
    if {$size==$($this,lastManagerSize)} {
        return
    }
    set ($this,lastManagerSize) $size
    set path $widget::($this,path)
    if {[grid propagate $path]} {
        return               ;# if there has not been any user interaction yet, let the grid manager handle the configuration change
    }
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    set lastSize 0
    set newSize $size
    if {[string match v* $composite::($this,-orient)]} {
        set itemName row
    } else {
        set itemName column
    }
    for {set itemIndex 0} {$itemIndex<=$lastIndex} {incr itemIndex} {
        if {($itemIndex%2)==0} {
            incr lastSize [grid ${itemName}configure $path $itemIndex -minsize]
        } else {
            incr newSize -$($this,handleSize)
        }
    }
    set ratio [expr {double($newSize)/$lastSize}]
    for {set itemIndex 0} {$itemIndex<$lastIndex} {incr itemIndex 2} {                      ;# set frame sizes except for last frame
        set size [expr {round($ratio*[grid ${itemName}configure $path $itemIndex -minsize])}]
        grid ${itemName}configure $path $itemIndex -minsize $size
        incr newSize -$size
    }
    grid ${itemName}configure $path $itemIndex -minsize $newSize            ;# last frame size is remainder to avoid rounding errors
}
