Changeset 5060 for branches/1.4


Ignore:
Timestamp:
Mar 3, 2015, 2:21:49 PM (10 years ago)
Author:
ldelgass
Message:

merge r5044,r5056 from trunk

Location:
branches/1.4
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • branches/1.4

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

    r4760 r5060  
    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.4/gui/scripts/imageresult.tcl

    r3844 r5060  
    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.4/gui/scripts/panes.tcl

    r3330 r5060  
    1 # -*- mode: tcl; indent-tabs-mode: nil -*-
    2 
     1# -*- mode: tcl; indent-tabs-mode: nil -*-
    32# ----------------------------------------------------------------------
    43#  COMPONENT: Panes - creates a series of adjustable panes
    … …  
    98# ======================================================================
    109#  AUTHOR:  Michael McLennan, Purdue University
    11 #  Copyright (c) 2004-2012  HUBzero Foundation, LLC
     10#  Copyright (c) 2004-2015  HUBzero Foundation, LLC
    1211#
    1312#  See the file "license.terms" for information on usage and
    … …  
    2120option add *Panes.sashWidth 2 widgetDefault
    2221option add *Panes.sashPadding 4 widgetDefault
    23 option add *Panes.sashCursor sb_v_double_arrow
     22option add *Panes.orientation vertical widgetDefault
    2423
    2524itcl::class Rappture::Panes {
    2625    inherit itk::Widget
    2726
    28     itk_option define -sashcursor sashCursor SashCursor ""
    2927    itk_option define -sashrelief sashRelief SashRelief ""
    3028    itk_option define -sashwidth sashWidth SashWidth 0
    3129    itk_option define -sashpadding sashPadding SashPadding 0
     30    itk_option define -orientation orientation Orientation ""
    3231
    3332    constructor {args} { # defined below }
    … …  
    3534    public method insert {pos args}
    3635    public method pane {pos}
    37     public method visibility {pos {newval ""}}
    38     public method fraction {pos {newval ""}}
     36    public method visibility {pos args}
     37    public method fraction {pos args}
    3938    public method hilite {state sash}
     39    public method size {}
    4040
    4141    protected method _grab {pane X Y}
    … …  
    4949    private variable _visibility ""  ;# list of visibilities for panes
    5050    private variable _counter 0      ;# counter for auto-generated names
    51     private variable _frac 0.0       ;# list of fractions
    52     public variable orientation "vertical"
     51    private variable _reqfrac 0.0    ;# requested fraction size of each pane
     52    private variable _dragfrom 0     ;# starting coordinate of drag operation
     53    private variable _dragfrac 0     ;# limit on fraction of drag operation
    5354}
    5455
    5556itk::usual Panes {
    56     keep -background -cursor
     57    keep -background -cursor -sashwidth -sashrelief
    5758}
    5859
    … …  
    8081    lappend _panes $pname
    8182    lappend _visibility 1
    82     set _frac 0.5
     83    set _reqfrac 0.5
    8384
    8485    eval itk_initialize $args
    … …  
    107108    } {
    108109        usual
    109         rename -cursor -sashcursor sashCursor SashCursor
     110        ignore -cursor
    110111    }
    111112    bind $itk_component($sash) <Enter> [itcl::code $this hilite on $sash]
    … …  
    116117    } {
    117118        usual
    118         rename -cursor -sashcursor sashCursor SashCursor
    119119        rename -relief -sashrelief sashRelief SashRelief
    120120        ignore -borderwidth
    121121    }
    122     if { $orientation == "vertical" } {
     122    if {$itk_option(-orientation) eq "vertical"} {
    123123        pack $itk_component(${sash}ridge) -fill x
     124        $itk_component($sash) configure -cursor sb_v_double_arrow
     125        $itk_component(${sash}ridge) configure -cursor sb_v_double_arrow
    124126    } else {
    125127        pack $itk_component(${sash}ridge) -fill y -side left
     128        $itk_component($sash) configure -cursor sb_h_double_arrow
     129        $itk_component(${sash}ridge) configure -cursor sb_h_double_arrow
    126130    }
    127131    foreach comp [list $sash ${sash}ridge] {
    … …  
    140144    set _panes [linsert $_panes $pos $pname]
    141145    set _visibility [linsert $_visibility $pos 1]
    142     set _frac [linsert $_frac $pos $params(-fraction)]
     146    set _reqfrac [linsert $_reqfrac $pos $params(-fraction)]
    143147
    144148    # fix sash characteristics
    … …  
    165169
    166170# ----------------------------------------------------------------------
    167 # USAGE: visibility <pos> ?<newval>?
     171# USAGE: visibility <pos> ?<newval>? ?<pos> <newval> ...?
    168172#
    169173# 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} {
     174# <pos>.  Can also be used to set the visibility for multiple panes
     175# if multiple <pos>/<newval> pairs are specified in the same command.
     176# ----------------------------------------------------------------------
     177itcl::body Rappture::Panes::visibility {pos args} {
     178    if {[llength $args] == 0} {
    174179        return [lindex $_visibility $pos]
    175180    }
    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>?
     181    if {[llength $args] % 2 == 0} {
     182        error "wrong # args: should be \"visibility pos ?val pos val ...?\""
     183    }
     184
     185    set args [linsert $args 0 $pos]
     186    foreach {pos newval} $args {
     187        if {![string is boolean -strict $newval]} {
     188            error "bad value \"$newval\": should be boolean"
     189        }
     190        if {$pos eq "end" || ($pos >= 0 && $pos < [llength $_visibility])} {
     191            set _visibility [lreplace $_visibility $pos $pos [expr {$newval}]]
     192            $_dispatcher event -idle !layout
     193        } else {
     194            error "bad index \"$pos\": out of range"
     195        }
     196    }
     197}
     198
     199# ----------------------------------------------------------------------
     200# USAGE: fraction <pos> ?<newval>? ?<pos> <newval> ...?
    189201#
    190202# 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"
     203# with the pane at position <pos>.  Can also be used to set the
     204# fractions for multiple panes if multiple <pos>/<newval> pairs
     205# are specified in the same command.
     206# ----------------------------------------------------------------------
     207itcl::body Rappture::Panes::fraction {pos args} {
     208    if {[llength $args] == 0} {
     209        return [lindex $_reqfrac $pos]
     210    }
     211    if {[llength $args] % 2 == 0} {
     212        error "wrong # args: should be \"fraction pos ?val pos val ...?\""
     213    }
     214
     215    set args [linsert $args 0 $pos]
     216    foreach {pos newval} $args {
     217        if {![string is double -strict $newval]} {
     218            error "bad value \"$newval\": should be fraction 0-1"
     219        }
     220        if {$pos eq "end" || ($pos >= 0 && $pos < [llength $_reqfrac])} {
     221            set _reqfrac [lreplace $_reqfrac $pos $pos $newval]
     222            $_dispatcher event -idle !layout
     223        } else {
     224            error "bad index \"$pos\": out of range"
     225        }
    221226    }
    222227}
    … …  
    230235itcl::body Rappture::Panes::hilite {state sash} {
    231236    switch -- $itk_option(-sashrelief) {
     237      flat {
     238        if {$state} {
     239            $itk_component(${sash}ridge) configure -background black
     240        } else {
     241            $itk_component(${sash}ridge) configure -background $itk_option(-background)
     242        }
     243      }
    232244      sunken {
    233245        if {$state} {
    … …  
    256268
    257269# ----------------------------------------------------------------------
     270# USAGE: size
     271#
     272# Returns the number of panes in this widget.  That makes it easier
     273# to index the various panes, since indices run from 0 to size-1.
     274# ----------------------------------------------------------------------
     275itcl::body Rappture::Panes::size {} {
     276    return [llength $_panes]
     277}
     278
     279# ----------------------------------------------------------------------
    258280# USAGE: _grab <pane> <X> <Y>
    259281#
    … …  
    262284# ----------------------------------------------------------------------
    263285itcl::body Rappture::Panes::_grab {pname X Y} {
     286    set pos [lsearch $_panes $pname]
     287    if {$pos < 0} return
     288    set frac0 [lindex $_reqfrac [expr {$pos-1}]]
     289    set frac1 [lindex $_reqfrac $pos]
     290    set _dragfrac [expr {$frac0+$frac1}]
     291
     292    if {$itk_option(-orientation) eq "vertical"} {
     293        set _dragfrom $Y
     294    } else {
     295        set _dragfrom $X
     296    }
    264297}
    265298
    … …  
    270303# ----------------------------------------------------------------------
    271304itcl::body Rappture::Panes::_drag {pname X Y} {
    272     if { $orientation == "vertical" } {
    273         set realY [expr {$Y-[winfo rooty $itk_component(hull)]}]
     305    set pos [lsearch $_panes $pname]
     306    if {$pos < 0} return
     307    set frac [lindex $_reqfrac $pos]
     308
     309    if {$itk_option(-orientation) eq "vertical"} {
     310        set delY [expr {$_dragfrom-$Y}]
    274311        set Ymax  [winfo height $itk_component(hull)]
    275         set frac [expr double($realY)/$Ymax]
     312        set delta [expr {double($delY)/$Ymax}]
     313        set frac [expr {$frac + $delta}]
     314        set _dragfrom $Y
    276315    } else {
    277         set realX [expr {$X-[winfo rootx $itk_component(hull)]}]
     316        set delX [expr {$_dragfrom-$X}]
    278317        set Xmax  [winfo width $itk_component(hull)]
    279         set frac [expr double($realX)/$Xmax]
    280     }
     318        set delta [expr {double($delX)/$Xmax}]
     319        set frac [expr {$frac + $delta}]
     320        set _dragfrom $X
     321    }
     322    if {$delta == 0.0} {
     323        return
     324    }
     325
     326    # set limits so the pane can't get too large or too small
    281327    if {$frac < 0.05} {
    282328        set frac 0.05
    283329    }
    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     }
     330    if {$frac > $_dragfrac-0.05} {
     331        set frac [expr {$_dragfrac-0.05}]
     332    }
     333
     334    # replace the fractions for this pane and the one before it
     335    set prevfrac [expr {$_dragfrac-$frac}]
     336    set _reqfrac [lreplace $_reqfrac [expr {$pos-1}] $pos $prevfrac $frac]
     337
     338    # normalize all fractions and fix the layout
    295339    _fixLayout
    296340
    … …  
    314358# ----------------------------------------------------------------------
    315359itcl::body Rappture::Panes::_fixLayout {args} {
    316     if { $orientation == "vertical" } {
     360    # normalize the fractions for all panes to they add to 1.0
     361    set total 0
     362    foreach f $_reqfrac v $_visibility {
     363        if {$v && $f > 0} {
     364            set total [expr {$total + $f}]
     365        }
     366    }
     367    if {$total == 0.0} { set total 1 }
     368
     369    set normfrac ""
     370    foreach f $_reqfrac v $_visibility {
     371        if {$v} {
     372            lappend normfrac [expr {double($f)/$total}]
     373        } else {
     374            lappend normfrac [expr {double($f)/$total}]
     375        }
     376    }
     377
     378    # note that sash padding can be a single number or different on each side
     379    if {[llength $itk_option(-sashpadding)] == 1} {
     380        set pad [expr {2*$itk_option(-sashpadding)}]
     381    } else {
     382        set pad [expr [join $itk_option(-sashpadding) +]]
     383    }
     384
     385    if {$itk_option(-orientation) eq "vertical"} {
    317386        set h [winfo height $itk_component(hull)]
     387        set sh [expr {$itk_option(-sashwidth) + $pad}]
    318388
    319389        set plist ""
    320390        set flist ""
    321         foreach p $_panes f $_frac v $_visibility {
     391        foreach p $_panes f $normfrac v $_visibility {
    322392            set sash ${p}sash
    323393            if {$v} {
    … …  
    326396                lappend flist $f
    327397                if {[info exists itk_component($sash)]} {
    328                     set h [expr {$h - [winfo reqheight $itk_component($sash)]}]
     398                    set h [expr {$h - $sh}]
    329399                }
    330400            } else {
    … …  
    336406            }
    337407        }
    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        
     408
    348409        # lay out the various panes
    349410        set y 0
    … …  
    351412            set sash ${p}sash
    352413            if {[info exists itk_component($sash)]} {
    353                 set sh [winfo reqheight $itk_component($sash)]
    354414                place $itk_component($sash) -y $y -relx 0.5 -anchor n \
    355415                    -relwidth 1.0 -height $sh
    … …  
    364424    } else {
    365425        set w [winfo width $itk_component(hull)]
     426        set sw [expr {$itk_option(-sashwidth) + $pad}]
    366427
    367428        set plist ""
    368429        set flist ""
    369         foreach p $_panes f $_frac v $_visibility {
     430        foreach p $_panes f $normfrac v $_visibility {
    370431            set sash ${p}sash
    371432            if {$v} {
    … …  
    374435                lappend flist $f
    375436                if {[info exists itk_component($sash)]} {
    376                     set w [expr {$w - [winfo reqwidth $itk_component($sash)]}]
     437                    set w [expr {$w - $sw}]
    377438                }
    378439            } else {
    … …  
    384445            }
    385446        }
    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        
     447
    396448        # lay out the various panes
    397449        set x 0
    … …  
    399451            set sash ${p}sash
    400452            if {[info exists itk_component($sash)]} {
    401                 set sw [winfo reqwidth $itk_component($sash)]
    402453                place $itk_component($sash) -x $x -rely 0.5 -anchor w \
    403454                    -relheight 1.0 -width $sw
    … …  
    420471# ----------------------------------------------------------------------
    421472itcl::body Rappture::Panes::_fixSashes {args} {
    422     if { $orientation == "vertical" } {
     473    if {$itk_option(-orientation) eq "vertical"} {
    423474        set ht [winfo pixels $itk_component(hull) $itk_option(-sashwidth)]
    424475        set bd [expr {$ht/2}]
    … …  
    426477            set sash "${pane}sashridge"
    427478            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)
     479                $itk_component($sash) configure -height $ht \
     480                    -borderwidth $bd -relief $itk_option(-sashrelief)
     481                pack $itk_component($sash) -pady $itk_option(-sashpadding) \
     482                    -side top
    436483            }
    437484        }
    … …  
    442489            set sash "${pane}sashridge"
    443490            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                 }
     491                $itk_component($sash) configure -width $w \
     492                    -borderwidth $bd -relief $itk_option(-sashrelief)
    451493                pack $itk_component($sash) -padx $itk_option(-sashpadding) \
    452494                    -side left
    … …  
    474516# ----------------------------------------------------------------------
    475517itcl::configbody Rappture::Panes::sashpadding {
     518    set count 0
     519    foreach val $itk_option(-sashpadding) {
     520        if {![string is integer -strict $val]} {
     521            error "bad padding value \"$val\": should be integer"
     522        }
     523        incr count
     524    }
     525    if {$count < 1 || $count > 2} {
     526        error "bad padding value \"$itk_option(-sashpadding)\": should be \"#\" or \"# #\""
     527    }
    476528    $_dispatcher event -idle !sashes
    477529}
     530
     531# ----------------------------------------------------------------------
     532# CONFIGURATION OPTION: -orientation
     533# ----------------------------------------------------------------------
     534itcl::configbody Rappture::Panes::orientation {
     535    foreach pname $_panes {
     536        set sash "${pname}sash"
     537        if {$itk_option(-orientation) eq "vertical"} {
     538            place $itk_component($pname) -x 0 -relx 0.5 -relwidth 1 \
     539                -y 0 -rely 0 -relheight 0
     540
     541            if {[info exists itk_component($sash)]} {
     542                place $itk_component($sash) -x 0 -relx 0.5 -relwidth 1 \
     543                    -y 0 -rely 0 -relheight 0
     544                $itk_component($sash) configure \
     545                    -cursor sb_v_double_arrow
     546
     547                pack $itk_component(${sash}ridge) -fill x -side top
     548                $itk_component(${sash}ridge) configure \
     549                    -cursor sb_v_double_arrow
     550            }
     551        } else {
     552            place $itk_component($pname) -y 0 -rely 0.5 -relheight 1 \
     553                -x 0 -relx 0 -relwidth 0
     554
     555            if {[info exists itk_component($sash)]} {
     556                place $itk_component($sash) -y 0 -rely 0.5 -relheight 1 \
     557                    -x 0 -relx 0 -relwidth 0
     558                $itk_component($sash) configure \
     559                    -cursor sb_h_double_arrow
     560
     561                pack $itk_component(${sash}ridge) -fill y -side left
     562                $itk_component(${sash}ridge) configure \
     563                    -cursor sb_h_double_arrow
     564            }
     565        }
     566    }
     567
     568    # fix sash characteristics
     569    $_dispatcher event -idle !sashes
     570
     571    # make sure we fix up the layout at some point
     572    $_dispatcher event -idle !layout
     573}
Note: See TracChangeset for help on using the changeset viewer.