source: trunk/gui/scripts/panes.tcl @ 111

# ----------------------------------------------------------------------
#  COMPONENT: Panes - creates a series of adjustable panes
#
#  This is a simple paned window with an adjustable sash.
#  the same quantity, but for various ranges of input values.
#  It also manages the controls to select and visualize the data.
# ======================================================================
#  AUTHOR:  Michael McLennan, Purdue University
#  Copyright (c) 2004-2005
#  Purdue Research Foundation, West Lafayette, IN
# ======================================================================
package require Itk

option add *Panes.width 3i widgetDefault
option add *Panes.height 3i widgetDefault
option add *Panes.sashCursor sb_v_double_arrow

itcl::class Rappture::Panes {
    inherit itk::Widget

    itk_option define -sashcursor sashCursor SashCursor ""

    constructor {args} { # defined below }

    public method insert {pos args}
    public method pane {pos}
    public method fraction {pos {newval ""}}

    protected method _grab {pane X Y}
    protected method _drag {pane X Y}
    protected method _drop {pane X Y}
    protected method _fixLayout {args}

    private variable _dispatcher ""  ;# dispatcher for !events
    private variable _panes ""       ;# list of pane frames
    private variable _counter 0      ;# counter for auto-generated names
    private variable _frac 1.0       ;# list of fractions
}

itk::usual Panes {
    keep -background -cursor
}

# ----------------------------------------------------------------------
# CONSTRUCTOR
# ----------------------------------------------------------------------
itcl::body Rappture::Panes::constructor {args} {
    itk_option add hull.width hull.height

    # create a dispatcher for events
    Rappture::dispatcher _dispatcher
    $_dispatcher register !layout
    $_dispatcher dispatch $this !layout [itcl::code $this _fixLayout]

    # fix the layout whenever the window size changes
    bind Panes <Configure> [itcl::code %W _fixLayout]

    set pname "pane[incr _counter]"
    itk_component add $pname {
        frame $itk_interior.$pname
    }

    lappend _panes $pname

    eval itk_initialize $args

    # make sure we fix up the layout at some point
    $_dispatcher event -idle !layout
}

# ----------------------------------------------------------------------
# USAGE: insert <pos> ?-fraction f?
#
# Adds a new page to this widget at the given position <pos>.
# ----------------------------------------------------------------------
itcl::body Rappture::Panes::insert {pos args} {
    Rappture::getopts args params {
        value -fraction 0.5
    }
    if {[llength $args] > 0} {
        error "wrong # args: should be \"insert pos ?-fraction f?\""
    }

    set pname "pane[incr _counter]"
    set sash "${pname}sash"
    itk_component add $sash {
        frame $itk_interior.$sash
    } {
        usual
        rename -cursor -sashcursor sashCursor SashCursor
    }

    itk_component add ${sash}ridge {
        frame $itk_component($sash).ridge \
            -height 2 -borderwidth 1 -relief sunken
    } {
        usual
        rename -cursor -sashcursor sashCursor SashCursor
    }
    pack $itk_component(${sash}ridge) -fill x -pady 4

    foreach comp [list $sash ${sash}ridge] {
        bind $itk_component($comp) <ButtonPress-1> \
            [itcl::code $this _grab $pname %X %Y]
        bind $itk_component($comp) <B1-Motion> \
            [itcl::code $this _drag $pname %X %Y]
        bind $itk_component($comp) <ButtonRelease-1> \
            [itcl::code $this _drop $pname %X %Y]
    }


    itk_component add $pname {
        frame $itk_interior.$pname
    }
    lappend _panes $pname

    # fix the fractional sizes
    set f $params(-fraction)
    set _frac [list [expr {1-$f}] $f]

    # make sure we fix up the layout at some point
    $_dispatcher event -idle !layout

    return $itk_component($pname)
}

# ----------------------------------------------------------------------
# USAGE: pane <pos>
#
# Returns the frame representing the pane at position <pos>.
# ----------------------------------------------------------------------
itcl::body Rappture::Panes::pane {pos} {
    set pname [lindex $_panes $pos]
    if {[info exists itk_component($pname)]} {
        return $itk_component($pname)
    }
    return ""
}

# ----------------------------------------------------------------------
# USAGE: fraction <pos> ?<newval>?
#
# Clients use this to get/set the fraction of real estate associated
# with the pane at position <pos>.
# ----------------------------------------------------------------------
itcl::body Rappture::Panes::fraction {pos {newval ""}} {
    if {"" == $newval} {
        return [lindex $_frac $pos]
    }
    if {![string is double $newval]} {
        error "bad value \"$newval\": should be fraction 0-1"
    }
    if {$pos == "end" || ($pos >= 0 && $pos < [llength $_frac])} {
        # if there are other panes, adjust their size according to this
        if {[llength $_frac] > 1} {
            set oldval [lindex $_frac $pos]
            set delta [expr {double($oldval-$newval)/([llength $_frac]-1)}]
            for {set i 0} {$i < [llength $_frac]} {incr i} {
                set v [lindex $_frac $i]
                set _frac [lreplace $_frac $i $i [expr {$v+$delta}]]
            }
        }
        set _frac [lreplace $_frac $pos $pos $newval]
        $_dispatcher event -idle !layout
    } else {
        error "bad index \"$pos\": out of range"
    }
}

# ----------------------------------------------------------------------
# USAGE: _grab <pane> <X> <Y>
#
# Invoked automatically when the user clicks on a sash, to initiate
# movement.
# ----------------------------------------------------------------------
itcl::body Rappture::Panes::_grab {pname X Y} {
}

# ----------------------------------------------------------------------
# USAGE: _drag <pane> <X> <Y>
#
# Invoked automatically as the user drags a sash, to resize the panes.
# ----------------------------------------------------------------------
itcl::body Rappture::Panes::_drag {pname X Y} {
    set realY [expr {$Y-[winfo rooty $itk_component(hull)]}]
    set Ymax  [winfo height $itk_component(hull)]
    set frac [expr double($realY)/$Ymax]
    if {$frac < 0.05} {
        set frac 0.05
    }
    if {$frac > 0.95} {
        set frac 0.95
    }

    set _frac [list $frac [expr {1-$frac}]]
    _fixLayout

    return $frac
}

# ----------------------------------------------------------------------
# USAGE: _drop <pane> <X> <Y>
#
# Invoked automatically as the user drops a sash, to resize the panes.
# ----------------------------------------------------------------------
itcl::body Rappture::Panes::_drop {pname X Y} {
    set frac [_drag $pname $X $Y]
}

# ----------------------------------------------------------------------
# USAGE: _fixLayout ?<eventArgs>...?
#
# Used internally to update the layout of panes whenever a new pane
# is added or a sash is moved.
# ----------------------------------------------------------------------
itcl::body Rappture::Panes::_fixLayout {args} {
    set h [winfo height $itk_component(hull)]
    foreach p [lrange $_panes 1 end] {
        set h [expr {$h - [winfo height $itk_component(${p}sash)]}]
    }

    set y 0
    foreach p $_panes f $_frac {
        set sash ${p}sash
        if {[info exists itk_component($sash)]} {
            set sh [winfo reqheight $itk_component($sash)]
            place $itk_component($sash) -y $y -relx 0.5 -anchor n \
                -relwidth 1.0 -height $sh
            set y [expr {$y + $sh}]
        }

        set ph [expr {$h*$f}]
        place $itk_component($p) -y $y -relx 0.5 -anchor n \
            -relwidth 1.0 -height $ph
        set y [expr {$y + $ph}]
    }
}