Changeset 5045 for branches


Ignore:
Timestamp:
Feb 23, 2015, 7:03:05 PM (10 years ago)
Author:
mmc
Message:

Ported changes to Panes widget over from trunk:
Fixed the Panes widget to handle fractional sizes better. Instead of
adjusting the fractions internally after each change, it keeps the
requested fractions, but normalizes them before the layout. This keeps
the behavior of the widget consistent, and keeps sizes closer to what
was requested for each pane. Also, fixed the -orientation option so
that the widget can switch back and forth between orientations.

Location:
branches/1.3/gui/scripts
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • branches/1.3/gui/scripts/analyzer.tcl

    r4760 r5045  
    315315
    316316    itk_component add results {
    317         Rappture::Panes $w.pane -sashwidth 1 -sashrelief solid -sashpadding {4 0}
     317        Rappture::Panes $w.pane \
     318            -sashwidth 2 -sashrelief solid -sashpadding {2 0}
     319    } {
     320        usual
     321        ignore -sashwidth -sashrelief -sashpadding
    318322    }
    319323    pack $itk_component(results) -expand yes -fill both

  • branches/1.3/gui/scripts/imageresult.tcl

    r3844 r5045  
    7272    pack propagate $itk_component(hull) no
    7373
    74     Rappture::Panes $itk_interior.panes -sashwidth 1 -sashrelief solid -sashpadding 2
     74    Rappture::Panes $itk_interior.panes \
     75        -sashwidth 2 -sashrelief solid -sashpadding 1
     76
    7577    pack $itk_interior.panes -expand yes -fill both
    7678    set main [$itk_interior.panes pane 0]

  • branches/1.3/gui/scripts/panes.tcl

    r3330 r5045  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*-
    2 
    31# ----------------------------------------------------------------------
    42#  COMPONENT: Panes - creates a series of adjustable panes
    … …  
    97# ======================================================================
    108#  AUTHOR:  Michael McLennan, Purdue University
    11 #  Copyright (c) 2004-2012  HUBzero Foundation, LLC
     9#  Copyright (c) 2004-2015  HUBzero Foundation, LLC
    1210#
    1311#  See the file "license.terms" for information on usage and
    … …  
    2119option add *Panes.sashWidth 2 widgetDefault
    2220option add *Panes.sashPadding 4 widgetDefault
    23 option add *Panes.sashCursor sb_v_double_arrow
     21option add *Panes.orientation vertical widgetDefault
    2422
    2523itcl::class Rappture::Panes {
    2624    inherit itk::Widget
    2725
    28     itk_option define -sashcursor sashCursor SashCursor ""
    2926    itk_option define -sashrelief sashRelief SashRelief ""
    3027    itk_option define -sashwidth sashWidth SashWidth 0
    3128    itk_option define -sashpadding sashPadding SashPadding 0
     29    itk_option define -orientation orientation Orientation ""
    3230
    3331    constructor {args} { # defined below }
    … …  
    3533    public method insert {pos args}
    3634    public method pane {pos}
    37     public method visibility {pos {newval ""}}
    38     public method fraction {pos {newval ""}}
     35    public method visibility {pos args}
     36    public method fraction {pos args}
    3937    public method hilite {state sash}
     38    public method size {}
    4039
    4140    protected method _grab {pane X Y}
    … …  
    4948    private variable _visibility ""  ;# list of visibilities for panes
    5049    private variable _counter 0      ;# counter for auto-generated names
    51     private variable _frac 0.0       ;# list of fractions
    52     public variable orientation "vertical"
     50    private variable _reqfrac 0.0    ;# requested fraction size of each pane
     51    private variable _dragfrom 0     ;# starting coordinate of drag operation
     52    private variable _dragfrac 0     ;# limit on fraction of drag operation
    5353}
    5454
    5555itk::usual Panes {
    56     keep -background -cursor
     56    keep -background -cursor -sashwidth -sashrelief
    5757}
    5858
    … …  
    8080    lappend _panes $pname
    8181    lappend _visibility 1
    82     set _frac 0.5
     82    set _reqfrac 0.5
    8383
    8484    eval itk_initialize $args
    … …  
    107107    } {
    108108        usual
    109         rename -cursor -sashcursor sashCursor SashCursor
     109        ignore -cursor
    110110    }
    111111    bind $itk_component($sash) <Enter> [itcl::code $this hilite on $sash]
    … …  
    116116    } {
    117117        usual
    118         rename -cursor -sashcursor sashCursor SashCursor
    119118        rename -relief -sashrelief sashRelief SashRelief
    120119        ignore -borderwidth
    121120    }
    122     if { $orientation == "vertical" } {
     121    if {$itk_option(-orientation) eq "vertical"} {
    123122        pack $itk_component(${sash}ridge) -fill x
     123        $itk_component($sash) configure -cursor sb_v_double_arrow
     124        $itk_component(${sash}ridge) configure -cursor sb_v_double_arrow
    124125    } else {
    125126        pack $itk_component(${sash}ridge) -fill y -side left
     127        $itk_component($sash) configure -cursor sb_h_double_arrow
     128        $itk_component(${sash}ridge) configure -cursor sb_h_double_arrow
    126129    }
    127130    foreach comp [list $sash ${sash}ridge] {
    … …  
    140143    set _panes [linsert $_panes $pos $pname]
    141144    set _visibility [linsert $_visibility $pos 1]
    142     set _frac [linsert $_frac $pos $params(-fraction)]
     145    set _reqfrac [linsert $_reqfrac $pos $params(-fraction)]
    143146
    144147    # fix sash characteristics
    … …  
    165168
    166169# ----------------------------------------------------------------------
    167 # USAGE: visibility <pos> ?<newval>?
     170# USAGE: visibility <pos> ?<newval>? ?<pos> <newval> ...?
    168171#
    169172# Clients use this to get/set the visibility of the pane at position
    170 # <pos>.
    171 # ----------------------------------------------------------------------
    172 itcl::body Rappture::Panes::visibility {pos {newval ""}} {
    173     if {"" == $newval} {
     173# <pos>.  Can also be used to set the visibility for multiple panes
     174# if multiple <pos>/<newval> pairs are specified in the same command.
     175# ----------------------------------------------------------------------
     176itcl::body Rappture::Panes::visibility {pos args} {
     177    if {[llength $args] == 0} {
    174178        return [lindex $_visibility $pos]
    175179    }
    176     if {![string is boolean $newval]} {
    177         error "bad value \"$newval\": should be boolean"
    178     }
    179     if {$pos == "end" || ($pos >= 0 && $pos < [llength $_visibility])} {
    180         set _visibility [lreplace $_visibility $pos $pos [expr {$newval}]]
    181         $_dispatcher event -idle !layout
    182     } else {
    183         error "bad index \"$pos\": out of range"
    184     }
    185 }
    186 
    187 # ----------------------------------------------------------------------
    188 # USAGE: fraction <pos> ?<newval>?
     180    if {[llength $args] % 2 == 0} {
     181        error "wrong # args: should be \"visibility pos ?val pos val ...?\""
     182    }
     183
     184    set args [linsert $args 0 $pos]
     185    foreach {pos newval} $args {
     186        if {![string is boolean -strict $newval]} {
     187            error "bad value \"$newval\": should be boolean"
     188        }
     189        if {$pos eq "end" || ($pos >= 0 && $pos < [llength $_visibility])} {
     190            set _visibility [lreplace $_visibility $pos $pos [expr {$newval}]]
     191            $_dispatcher event -idle !layout
     192        } else {
     193            error "bad index \"$pos\": out of range"
     194        }
     195    }
     196}
     197
     198# ----------------------------------------------------------------------
     199# USAGE: fraction <pos> ?<newval>? ?<pos> <newval> ...?
    189200#
    190201# Clients use this to get/set the fraction of real estate associated
    191 # with the pane at position <pos>.
    192 # ----------------------------------------------------------------------
    193 itcl::body Rappture::Panes::fraction {pos {newval ""}} {
    194     if {"" == $newval} {
    195         return [lindex $_frac $pos]
    196     }
    197     if {![string is double $newval]} {
    198         error "bad value \"$newval\": should be fraction 0-1"
    199     }
    200     if {$pos == "end" || ($pos >= 0 && $pos < [llength $_frac])} {
    201         set len [llength $_frac]
    202         set _frac [lreplace $_frac $pos $pos xxx]
    203         set total 0
    204         foreach f $_frac {
    205             if {"xxx" != $f} {
    206                 set total [expr {$total+$f}]
    207             }
    208         }
    209         for {set i 0} {$i < $len} {incr i} {
    210             set f [lindex $_frac $i]
    211             if {"xxx" == $f} {
    212                 set f $newval
    213             } else {
    214                 set f [expr {$f/$total - $newval/double($len-1)}]
    215             }
    216             set _frac [lreplace $_frac $i $i $f]
    217         }
    218         $_dispatcher event -idle !layout
    219     } else {
    220         error "bad index \"$pos\": out of range"
     202# with the pane at position <pos>.  Can also be used to set the
     203# fractions for multiple panes if multiple <pos>/<newval> pairs
     204# are specified in the same command.
     205# ----------------------------------------------------------------------
     206itcl::body Rappture::Panes::fraction {pos args} {
     207    if {[llength $args] == 0} {
     208        return [lindex $_reqfrac $pos]
     209    }
     210    if {[llength $args] % 2 == 0} {
     211        error "wrong # args: should be \"fraction pos ?val pos val ...?\""
     212    }
     213
     214    set args [linsert $args 0 $pos]
     215    foreach {pos newval} $args {
     216        if {![string is double -strict $newval]} {
     217            error "bad value \"$newval\": should be fraction 0-1"
     218        }
     219        if {$pos eq "end" || ($pos >= 0 && $pos < [llength $_reqfrac])} {
     220            set _reqfrac [lreplace $_reqfrac $pos $pos $newval]
     221            $_dispatcher event -idle !layout
     222        } else {
     223            error "bad index \"$pos\": out of range"
     224        }
    221225    }
    222226}
    … …  
    230234itcl::body Rappture::Panes::hilite {state sash} {
    231235    switch -- $itk_option(-sashrelief) {
     236      flat {
     237        if {$state} {
     238            $itk_component(${sash}ridge) configure -background black
     239        } else {
     240            $itk_component(${sash}ridge) configure -background $itk_option(-background)
     241        }
     242      }
    232243      sunken {
    233244        if {$state} {
    … …  
    256267
    257268# ----------------------------------------------------------------------
     269# USAGE: size
     270#
     271# Returns the number of panes in this widget.  That makes it easier
     272# to index the various panes, since indices run from 0 to size-1.
     273# ----------------------------------------------------------------------
     274itcl::body Rappture::Panes::size {} {
     275    return [llength $_panes]
     276}
     277
     278# ----------------------------------------------------------------------
    258279# USAGE: _grab <pane> <X> <Y>
    259280#
    … …  
    262283# ----------------------------------------------------------------------
    263284itcl::body Rappture::Panes::_grab {pname X Y} {
     285    set pos [lsearch $_panes $pname]
     286    if {$pos < 0} return
     287    set frac0 [lindex $_reqfrac [expr {$pos-1}]]
     288    set frac1 [lindex $_reqfrac $pos]
     289    set _dragfrac [expr {$frac0+$frac1}]
     290
     291    if {$itk_option(-orientation) eq "vertical"} {
     292        set _dragfrom $Y
     293    } else {
     294        set _dragfrom $X
     295    }
    264296}
    265297
    … …  
    270302# ----------------------------------------------------------------------
    271303itcl::body Rappture::Panes::_drag {pname X Y} {
    272     if { $orientation == "vertical" } {
    273         set realY [expr {$Y-[winfo rooty $itk_component(hull)]}]
     304    set pos [lsearch $_panes $pname]
     305    if {$pos < 0} return
     306    set frac [lindex $_reqfrac $pos]
     307
     308    if {$itk_option(-orientation) eq "vertical"} {
     309        set delY [expr {$_dragfrom-$Y}]
    274310        set Ymax  [winfo height $itk_component(hull)]
    275         set frac [expr double($realY)/$Ymax]
     311        set delta [expr {double($delY)/$Ymax}]
     312        set frac [expr {$frac + $delta}]
     313        set _dragfrom $Y
    276314    } else {
    277         set realX [expr {$X-[winfo rootx $itk_component(hull)]}]
     315        set delX [expr {$_dragfrom-$X}]
    278316        set Xmax  [winfo width $itk_component(hull)]
    279         set frac [expr double($realX)/$Xmax]
    280     }
     317        set delta [expr {double($delX)/$Xmax}]
     318        set frac [expr {$frac + $delta}]
     319        set _dragfrom $X
     320    }
     321    if {$delta == 0.0} {
     322        return
     323    }
     324
     325    # set limits so the pane can't get too large or too small
    281326    if {$frac < 0.05} {
    282327        set frac 0.05
    283328    }
    284     if {$frac > 0.95} {
    285         set frac 0.95
    286     }
    287     if {[llength $_frac] == 2} {
    288         set _frac [list $frac [expr {1-$frac}]]
    289     } else {
    290         set i [expr {[lsearch $_panes $pname]-1}]
    291         if {$i >= 0} {
    292             set _frac [lreplace $_frac $i $i $frac]
    293         }
    294     }
     329    if {$frac > $_dragfrac-0.05} {
     330        set frac [expr {$_dragfrac-0.05}]
     331    }
     332
     333    # replace the fractions for this pane and the one before it
     334    set prevfrac [expr {$_dragfrac-$frac}]
     335    set _reqfrac [lreplace $_reqfrac [expr {$pos-1}] $pos $prevfrac $frac]
     336
     337    # normalize all fractions and fix the layout
    295338    _fixLayout
    296339
    … …  
    314357# ----------------------------------------------------------------------
    315358itcl::body Rappture::Panes::_fixLayout {args} {
    316     if { $orientation == "vertical" } {
     359    # normalize the fractions for all panes to they add to 1.0
     360    set total 0
     361    foreach f $_reqfrac v $_visibility {
     362        if {$v && $f > 0} {
     363            set total [expr {$total + $f}]
     364        }
     365    }
     366    if {$total == 0.0} { set total 1 }
     367
     368    set normfrac ""
     369    foreach f $_reqfrac v $_visibility {
     370        if {$v} {
     371            lappend normfrac [expr {double($f)/$total}]
     372        } else {
     373            lappend normfrac [expr {double($f)/$total}]
     374        }
     375    }
     376
     377    # note that sash padding can be a single number or different on each side
     378    if {[llength $itk_option(-sashpadding)] == 1} {
     379        set pad [expr {2*$itk_option(-sashpadding)}]
     380    } else {
     381        set pad [expr [join $itk_option(-sashpadding) +]]
     382    }
     383
     384    if {$itk_option(-orientation) eq "vertical"} {
    317385        set h [winfo height $itk_component(hull)]
     386        set sh [expr {$itk_option(-sashwidth) + $pad}]
    318387
    319388        set plist ""
    320389        set flist ""
    321         foreach p $_panes f $_frac v $_visibility {
     390        foreach p $_panes f $normfrac v $_visibility {
    322391            set sash ${p}sash
    323392            if {$v} {
    … …  
    326395                lappend flist $f
    327396                if {[info exists itk_component($sash)]} {
    328                     set h [expr {$h - [winfo reqheight $itk_component($sash)]}]
     397                    set h [expr {$h - $sh}]
    329398                }
    330399            } else {
    … …  
    336405            }
    337406        }
    338        
    339         # normalize the fractions so they add up to 1
    340         set total 0
    341         foreach f $flist { set total [expr {$total+$f}] }
    342         set newflist ""
    343         foreach f $flist {
    344             lappend newflist [expr {double($f)/$total}]
    345         }
    346         set flist $newflist
    347        
     407
    348408        # lay out the various panes
    349409        set y 0
    … …  
    351411            set sash ${p}sash
    352412            if {[info exists itk_component($sash)]} {
    353                 set sh [winfo reqheight $itk_component($sash)]
    354413                place $itk_component($sash) -y $y -relx 0.5 -anchor n \
    355414                    -relwidth 1.0 -height $sh
    … …  
    364423    } else {
    365424        set w [winfo width $itk_component(hull)]
     425        set sw [expr {$itk_option(-sashwidth) + $pad}]
    366426
    367427        set plist ""
    368428        set flist ""
    369         foreach p $_panes f $_frac v $_visibility {
     429        foreach p $_panes f $normfrac v $_visibility {
    370430            set sash ${p}sash
    371431            if {$v} {
    … …  
    374434                lappend flist $f
    375435                if {[info exists itk_component($sash)]} {
    376                     set w [expr {$w - [winfo reqwidth $itk_component($sash)]}]
     436                    set w [expr {$w - $sw}]
    377437                }
    378438            } else {
    … …  
    384444            }
    385445        }
    386        
    387         # normalize the fractions so they add up to 1
    388         set total 0
    389         foreach f $flist { set total [expr {$total+$f}] }
    390         set newflist ""
    391         foreach f $flist {
    392             lappend newflist [expr {double($f)/$total}]
    393         }
    394         set flist $newflist
    395        
     446
    396447        # lay out the various panes
    397448        set x 0
    … …  
    399450            set sash ${p}sash
    400451            if {[info exists itk_component($sash)]} {
    401                 set sw [winfo reqwidth $itk_component($sash)]
    402452                place $itk_component($sash) -x $x -rely 0.5 -anchor w \
    403453                    -relheight 1.0 -width $sw
    … …  
    420470# ----------------------------------------------------------------------
    421471itcl::body Rappture::Panes::_fixSashes {args} {
    422     if { $orientation == "vertical" } {
     472    if {$itk_option(-orientation) eq "vertical"} {
    423473        set ht [winfo pixels $itk_component(hull) $itk_option(-sashwidth)]
    424474        set bd [expr {$ht/2}]
    … …  
    426476            set sash "${pane}sashridge"
    427477            if {[info exists itk_component($sash)]} {
    428                 $itk_component($sash) configure -height $ht -borderwidth $bd
    429                 if {$itk_option(-sashrelief) == "solid"} {
    430                     $itk_component($sash) configure -background black
    431                 } else {
    432                     $itk_component($sash) configure \
    433                         -background $itk_option(-background)
    434                 }
    435                 pack $itk_component($sash) -pady $itk_option(-sashpadding)
     478                $itk_component($sash) configure -height $ht \
     479                    -borderwidth $bd -relief $itk_option(-sashrelief)
     480                pack $itk_component($sash) -pady $itk_option(-sashpadding) \
     481                    -side top
    436482            }
    437483        }
    … …  
    442488            set sash "${pane}sashridge"
    443489            if {[info exists itk_component($sash)]} {
    444                 $itk_component($sash) configure -width $w -borderwidth $bd
    445                 if {$itk_option(-sashrelief) == "solid"} {
    446                     $itk_component($sash) configure -background black
    447                 } else {
    448                     $itk_component($sash) configure \
    449                         -background $itk_option(-background)
    450                 }
     490                $itk_component($sash) configure -width $w \
     491                    -borderwidth $bd -relief $itk_option(-sashrelief)
    451492                pack $itk_component($sash) -padx $itk_option(-sashpadding) \
    452493                    -side left
    … …  
    474515# ----------------------------------------------------------------------
    475516itcl::configbody Rappture::Panes::sashpadding {
     517    set count 0
     518    foreach val $itk_option(-sashpadding) {
     519        if {![string is integer -strict $val]} {
     520            error "bad padding value \"$val\": should be integer"
     521        }
     522        incr count
     523    }
     524    if {$count < 1 || $count > 2} {
     525        error "bad padding value \"$itk_option(-sashpadding)\": should be \"#\" or \"# #\""
     526    }
    476527    $_dispatcher event -idle !sashes
    477528}
     529
     530# ----------------------------------------------------------------------
     531# CONFIGURATION OPTION: -orientation
     532# ----------------------------------------------------------------------
     533itcl::configbody Rappture::Panes::orientation {
     534    foreach pname $_panes {
     535        set sash "${pname}sash"
     536        if {$itk_option(-orientation) eq "vertical"} {
     537            place $itk_component($pname) -x 0 -relx 0.5 -relwidth 1 \
     538                -y 0 -rely 0 -relheight 0
     539
     540            if {[info exists itk_component($sash)]} {
     541                place $itk_component($sash) -x 0 -relx 0.5 -relwidth 1 \
     542                    -y 0 -rely 0 -relheight 0
     543                $itk_component($sash) configure \
     544                    -cursor sb_v_double_arrow
     545
     546                pack $itk_component(${sash}ridge) -fill x -side top
     547                $itk_component(${sash}ridge) configure \
     548                    -cursor sb_v_double_arrow
     549            }
     550        } else {
     551            place $itk_component($pname) -y 0 -rely 0.5 -relheight 1 \
     552                -x 0 -relx 0 -relwidth 0
     553
     554            if {[info exists itk_component($sash)]} {
     555                place $itk_component($sash) -y 0 -rely 0.5 -relheight 1 \
     556                    -x 0 -relx 0 -relwidth 0
     557                $itk_component($sash) configure \
     558                    -cursor sb_h_double_arrow
     559
     560                pack $itk_component(${sash}ridge) -fill y -side left
     561                $itk_component(${sash}ridge) configure \
     562                    -cursor sb_h_double_arrow
     563            }
     564        }
     565    }
     566
     567    # fix sash characteristics
     568    $_dispatcher event -idle !sashes
     569
     570    # make sure we fix up the layout at some point
     571    $_dispatcher event -idle !layout
     572}
Note: See TracChangeset for help on using the changeset viewer.