source: trunk/gui/scripts/sidebarframe.tcl @ 3330

Last change on this file since 3330 was 3330, checked in by gah, 12 years ago

merge (by hand) with Rappture1.2 branch

File size: 20.0 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: SidebarFrame - pop-out controls for visualization widgets
4#
5#  The sidebar provides a way to put a thin strip of controls along the
6#  side of a visualization widget, with tabs that cause control panels
7#  to pop out.  The SidebarFrame has an empty frame (component "frame")
8#  on the left and a sidebar that pops out on the right.
9# ======================================================================
10#  AUTHOR:  George Howlett, Michael McLennan, Purdue University
11#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
12#
13#  See the file "license.terms" for information on usage and
14#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15# ======================================================================
16package require Itk
17
18option add *SidebarFrame.width 3i widgetDefault
19option add *SidebarFrame.height 3i widgetDefault
20option add *SidebarFrame.titlebarBackground #6666cc widgetDefault
21option add *SidebarFrame.titlebarForeground white widgetDefault
22option add *SidebarFrame.controlBackground gray widgetDefault
23option add *SidebarFrame*cntls*highlightBackground gray widgetDefault
24option add *SidebarFrame.sashRelief flat widgetDefault
25option add *SidebarFrame.sashActiveRelief solid widgetDefault
26option add *SidebarFrame.sashColor gray widgetDefault
27option add *SidebarFrame.sashWidth 2 widgetDefault
28option add *SidebarFrame.sashPadding 2 widgetDefault
29option add *SidebarFrame.sashCursor sb_h_double_arrow
30
31itcl::class Rappture::SidebarFrame {
32    inherit itk::Widget
33
34    itk_option define -sashrelief sashRelief Relief ""
35    itk_option define -sashactiverelief sashActiveRelief SashActiveRelief ""
36    itk_option define -sashcolor sashColor SashColor ""
37    itk_option define -sashwidth sashWidth SashWidth 0
38    itk_option define -sashpadding sashPadding SashPadding 0
39    itk_option define -sashcursor sashCursor Cursor ""
40
41    public variable resizeframe 1
42    constructor {args} { # defined below }
43
44    public method insert {pos args}
45    public method panel {which}
46    public method select {which}
47    public method pop {what}
48    public method width { size } {
49        set _width $size
50    }
51    public method enable { which }
52    public method disable { which }
53
54    protected method _toggleTab {which}
55    protected method _sash {op x}
56    protected method _fixLayout {args}
57    protected method TabIndex { which }
58
59    private variable _dispatcher ""  ;# dispatcher for !events
60    private variable _state "closed" ;# sidebar open/closed
61    private variable _panels         ;# maps panel => title, etc.
62    private variable _selected ""    ;# selected panel
63    private variable _width "auto"   ;# width adjusted by sash or "auto"
64    private variable _counter 0      ;# counter for auto-generated names
65}
66
67itk::usual SidebarFrame {
68    keep -background -cursor
69    keep -titlebarbackground -titlebarforeground
70}
71
72# ----------------------------------------------------------------------
73# CONSTRUCTOR
74# ----------------------------------------------------------------------
75itcl::body Rappture::SidebarFrame::constructor {args} {
76    itk_option add hull.width hull.height
77
78    # create a dispatcher for events
79    Rappture::dispatcher _dispatcher
80    $_dispatcher register !layout
81    $_dispatcher dispatch $this !layout [itcl::code $this _fixLayout]
82
83    # fix the layout whenever the window size changes
84    bind SidebarFrame <Configure> [itcl::code %W _fixLayout]
85
86    #
87    # Empty frame for main widget
88    #
89    itk_component add frame {
90        frame $itk_interior.f
91    }
92
93    #
94    # Sash along the left side of sidebar
95    #
96    itk_component add sashbg {
97        frame $itk_interior.sashbg
98    } {
99        usual
100        rename -cursor -sashcursor sashCursor Cursor
101    }
102
103    itk_component add sash {
104        frame $itk_component(sashbg).sash -borderwidth 1
105    } {
106        usual
107        ignore -background -borderwidth
108        rename -relief -sashrelief sashRelief Relief
109        rename -width -sashwidth sashWidth SashWidth
110        rename -cursor -sashcursor sashCursor Cursor
111    }
112    pack $itk_component(sash) -side left -fill y
113
114    foreach c {sash sashbg} {
115        bind $itk_component($c) <Enter> \
116            [itcl::code $this _sash enter %X]
117        bind $itk_component($c) <Leave> \
118            [itcl::code $this _sash leave %X]
119        bind $itk_component($c) <ButtonPress-1> \
120            [itcl::code $this _sash grab %X]
121        bind $itk_component($c) <B1-Motion> \
122            [itcl::code $this _sash drag %X]
123        bind $itk_component($c) <ButtonRelease-1> \
124            [itcl::code $this _sash release %X]
125    }
126
127    itk_component add sidebar {
128        frame $itk_interior.sbar
129    }
130
131    #
132    # Title bar along top of sidebar
133    #
134    itk_component add titlebar {
135        frame $itk_component(sidebar).tbar -highlightthickness 0
136    } {
137        usual
138        ignore -highlightthickness
139        rename -background -titlebarbackground titlebarBackground Background
140    }
141    pack $itk_component(titlebar) -side top -fill x
142
143    itk_component add popbutton {
144        button $itk_component(titlebar).popb \
145            -borderwidth 1 -relief flat -overrelief raised \
146            -highlightthickness 0 \
147            -image [Rappture::icon sbar-open] \
148            -command [itcl::code $this pop toggle]
149    } {
150        usual
151        ignore -borderwidth -relief -overrelief -highlightthickness
152        rename -background -titlebarbackground titlebarBackground Background
153        rename -activebackground -titlebarbackground titlebarBackground Background
154    }
155    pack $itk_component(popbutton) -side left -padx 6 -pady 2
156    Rappture::Tooltip::for $itk_component(popbutton) \
157        "Open/close the sidebar"
158
159    itk_component add title {
160        label $itk_component(titlebar).title -anchor w -font "Arial 10"
161    } {
162        usual
163        ignore -font
164        rename -foreground -titlebarforeground titlebarForeground Foreground
165        rename -background -titlebarbackground titlebarBackground Background
166    }
167    pack $itk_component(title) -side left -expand yes -fill both -padx 1 -pady 1
168
169    #
170    # Area for active panel
171    #
172    itk_component add area {
173        Rappture::Scroller $itk_component(sidebar).area \
174            -xscrollmode auto -yscrollmode auto \
175            -highlightthickness 0
176    }
177    $itk_component(area) contents frame
178
179    itk_component add controlbar {
180        frame $itk_component(sidebar).cbar
181    } {
182        usual
183        rename -background -controlbackground controlBackground Background
184    }
185    pack $itk_component(controlbar) -side left -fill y
186
187    #
188    # Control area above the tabs
189    #
190    itk_component add controls {
191        frame $itk_component(controlbar).cntls -height 20
192    } {
193        usual
194        rename -background -controlbackground controlBackground Background
195    }
196    pack $itk_component(controls) -side top -pady {8 20}
197
198    #
199    # Tabs used to select sidebar panels. 
200    #
201    # Note:  Bugs in BLT 2.4 tabset/VNC server crashes the server
202    #        when -outerpad is set to 0.
203    #
204    itk_component add tabs {
205        blt::tabset $itk_component(controlbar).tabs \
206            -highlightthickness 0 -tearoff 0 -side left \
207            -bd 0 -gap 0 -tabborderwidth 1 \
208            -outerpad 1
209    } {
210        keep -background -cursor
211        ignore -highlightthickness -borderwidth
212        rename -highlightbackground -controlbackground controlBackground \
213            Background
214        rename -background -controlbackground controlBackground \
215            Background
216    }
217    pack $itk_component(tabs) -side top -expand yes -anchor e -padx {4 0} -fill y
218
219    eval itk_initialize $args
220
221    # make sure we fix up the layout at some point
222    $_dispatcher event -idle !layout
223}
224
225# ----------------------------------------------------------------------
226# USAGE: insert <pos> ?-title t? ?-icon i?
227#
228# Adds a new panel into this widget at the given position <pos>.  The
229# panel has a tab with the specified -icon, and is labeled by the
230# -title string in the titlebar area when it is selected.
231# ----------------------------------------------------------------------
232itcl::body Rappture::SidebarFrame::insert {pos args} {
233    Rappture::getopts args panel "
234        value -title Options
235        value -icon [Rappture::icon cboff]
236    "
237    if {[llength $args] > 0} {
238        error "wrong # args: should be \"insert pos ?-title t? ?-icon i?\""
239    }
240
241    set f [$itk_component(area) contents]
242    set pname "panel[incr _counter]"
243    itk_component add $pname {
244        frame $f.$pname
245    }
246
247    $itk_component(tabs) insert end $pname \
248        -image $panel(-icon) -text "" -padx 0 -pady 0 \
249        -command [itcl::code $this _toggleTab $pname]
250
251    Rappture::Tooltip::text $itk_component(tabs)-$pname \
252        "Open/close sidebar for $panel(-title)"
253    $itk_component(tabs) bind $pname <Enter> \
254        [list ::Rappture::Tooltip::tooltip pending %W-$pname @%X,%Y]
255    $itk_component(tabs) bind $pname <Leave> \
256        [list ::Rappture::Tooltip::tooltip cancel]
257    $itk_component(tabs) bind $pname <ButtonPress> \
258        [list ::Rappture::Tooltip::tooltip cancel]
259    $itk_component(tabs) bind $pname <KeyPress> \
260        [list ::Rappture::Tooltip::tooltip cancel]
261
262    set _panels($pname-title) $panel(-title)
263    lappend _panels(all) $pname
264    if {$_selected == ""} {
265        set _selected $pname
266        if {$_state == "open"} {
267            $itk_component(title) configure -text $panel(-title)
268        }
269    }
270
271    return $itk_component($pname)
272}
273
274# ----------------------------------------------------------------------
275# USAGE: panel <which>
276#
277# Returns the frame representing the requested panel.  The <which>
278# argument can be a panel index, name, or title, or the keyword
279# "current" for the selected panel.
280# ----------------------------------------------------------------------
281itcl::body Rappture::SidebarFrame::panel {which} {
282    switch -glob -- $which {
283        current {
284            return $itk_component($_selected)
285        }
286        [0-9]* {
287            set pname [lindex $_panels(all) $which]
288            return $itk_component($pname)
289        }
290        panel[0-9]* {
291            if {[info exists itk_component($which)]} {
292                return $itk_component($which)
293            }
294            error "bad panel name \"$which\""
295        }
296        default {
297            foreach pname $_panels(all) {
298                if {[string equal $_panels($pname-title) $which]} {
299                    return $itk_component($pname)
300                }
301            }
302            error "bad panel title \"$which\""
303        }
304    }
305}
306
307# ----------------------------------------------------------------------
308# USAGE: select <which>
309#
310# Pops open the sidebar and selects the specified panel.  The <which>
311# argument can be a panel index, name, or title.
312# ----------------------------------------------------------------------
313itcl::body Rappture::SidebarFrame::select {which} {
314    set pname ""
315    switch -glob -- $which {
316        [0-9]* {
317            set pname [lindex $_panels(all) $which]
318        }
319        panel[0-9]* {
320            if {[info exists itk_component($which)]} {
321                set pname $which
322            }
323        }
324        default {
325            foreach p $_panels(all) {
326                if {[string equal $_panels($p-title) $which]} {
327                    set pname $p
328                    break
329                }
330            }
331        }
332    }
333    if {$pname == ""} {
334        error "bad panel name \"$which\": should be panel id, title, or index"
335    }
336
337    if {$_state == "closed"} {
338        pop open
339    }
340
341    set minw [winfo reqwidth $itk_component(controlbar)]
342    if {$_width != "auto" && $_width < $minw+50} {
343        set _width [expr {$minw+50}]
344        $_dispatcher event -idle !layout
345    }
346    set n [$itk_component(tabs) index -name $pname]
347    $itk_component(tabs) select $n
348
349    $itk_component(title) configure -text $_panels($pname-title)
350
351    set f [$itk_component(area) contents]
352    foreach w [pack slaves $f] {
353        pack forget $w
354    }
355    pack $itk_component($pname) -expand yes -fill both
356
357    #
358    # HACK ALERT!  Force the scroller to check the size of the
359    # panel that we just slid in under the covers.  Make it
360    # think the panel and the scroller itself have changed size.
361    #
362    event generate [winfo parent $f] <Configure>
363    event generate $f <Configure>
364
365    set _selected $pname
366    return $pname
367}
368
369# ----------------------------------------------------------------------
370# USAGE: pop open|close|toggle
371#
372# Used to open/close the sidebar area.  When open, the selected panel
373# appears and the titlebar shows its name.
374# ----------------------------------------------------------------------
375itcl::body Rappture::SidebarFrame::pop {how} {
376    if {$how == "toggle"} {
377        if {$_state == "closed"} {
378            set how "open"
379        } else {
380            set how "close"
381        }
382    }
383
384    switch -- $how {
385        open {
386            $itk_component(popbutton) configure \
387                -image [Rappture::icon sbar-closed]
388            pack $itk_component(area) -side right -expand yes -fill both
389
390            set _state "open"
391            select $_selected
392            $_dispatcher event -idle !layout
393        }
394        close {
395            $itk_component(popbutton) configure \
396                -image [Rappture::icon sbar-open]
397            $itk_component(title) configure -text ""
398            pack forget $itk_component(area)
399
400            set _state "closed"
401            $_dispatcher event -idle !layout
402        }
403        default {
404            error "bad option \"$how\": should be open, close, toggle"
405        }
406    }
407}
408
409# ----------------------------------------------------------------------
410# USAGE: disable <which>
411#
412# Pops open the sidebar and selects the specified panel.  The <which>
413# argument can be a panel index, name, or title.
414# ----------------------------------------------------------------------
415itcl::body Rappture::SidebarFrame::disable {which} {
416    set index [TabIndex $which]
417    set tab [$itk_component(tabs) get $index]
418    $itk_component(tabs) tab configure $tab -state disabled
419}
420
421
422# ----------------------------------------------------------------------
423# USAGE: enable <which>
424#
425# Pops open the sidebar and selects the specified panel.  The <which>
426# argument can be a panel index, name, or title.
427# ----------------------------------------------------------------------
428itcl::body Rappture::SidebarFrame::enable {which} {
429    set index [TabIndex $which]
430    set tab [$itk_component(tabs) get $index]
431    $itk_component(tabs) tab configure $tab -state normal
432}
433
434# ----------------------------------------------------------------------
435# USAGE: TabIndex <which>
436#
437# Pops open the sidebar and selects the specified panel.  The <which>
438# argument can be a panel index, name, or title.
439# ----------------------------------------------------------------------
440itcl::body Rappture::SidebarFrame::TabIndex {which} {
441    set pname ""
442    switch -glob -- $which {
443        [0-9]* {
444            set pname [lindex $_panels(all) $which]
445        }
446        panel[0-9]* {
447            if {[info exists itk_component($which)]} {
448                set pname $which
449            }
450        }
451        default {
452            foreach p $_panels(all) {
453                if {[string equal $_panels($p-title) $which]} {
454                    set pname $p
455                    break
456                }
457            }
458        }
459    }
460    if {$pname == ""} {
461        error "bad panel name \"$which\": should be panel id, title, or index"
462    }
463    set n [$itk_component(tabs) index -name $pname]
464    return $n
465}
466
467# ----------------------------------------------------------------------
468# USAGE: _toggleTab <which>
469#
470# Invoked automatically when the user clicks on a tab for the sidebar.
471# If the sidebar is closed, it is automatically opened and the tab is
472# selected.  If the sidebar is opened, then it's closed.
473# ----------------------------------------------------------------------
474itcl::body Rappture::SidebarFrame::_toggleTab {which} {
475    if {$_state == "closed"} {
476        pop open
477        select $which
478    } elseif {[$itk_component(tabs) index -name $_selected]
479          == [$itk_component(tabs) index -name $which]} {
480        pop close
481    } else {
482        select $which
483    }
484}
485
486# ----------------------------------------------------------------------
487# USAGE: _sash <op> <X>
488#
489# Invoked automatically when the user clicks/drags on a sash, to resize
490# the sidebar.
491# ----------------------------------------------------------------------
492itcl::body Rappture::SidebarFrame::_sash {op X} {
493    switch -- $op {
494        enter {
495            # mouse over sash -- make it active
496            if {$itk_option(-sashactiverelief) != ""} {
497                $itk_component(sash) configure -relief $itk_option(-sashactiverelief)
498            }
499        }
500        leave {
501            # mouse left sash -- back to normal
502            $itk_component(sash) configure -relief $itk_option(-sashrelief)
503        }
504        grab {
505            if {$_state == "closed"} { pop open }
506            _sash drag $X
507        }
508        drag {
509            set w [winfo width $itk_component(hull)]
510            set minw [winfo reqwidth $itk_component(controlbar)]
511            set dx [expr {$X - [winfo rootx $itk_component(hull)]}]
512            set sashw [winfo reqwidth $itk_component(sashbg)]
513            set _width [expr {$w - $dx - $sashw/2}]
514
515            if {$_width < $minw} { set _width $minw }
516            if {$_width > $w-50} { set _width [expr {$w-50}] }
517            _fixLayout
518        }
519        release {
520            set minw [winfo reqwidth $itk_component(controlbar)]
521            if {$_width-$minw < 40} {
522                set _width "auto"
523                pop close
524            }
525        }
526        default {
527            error "bad option \"$op\": should be enter, leave, grab, drag, release"
528        }
529    }
530}
531
532# ----------------------------------------------------------------------
533# USAGE: _fixLayout ?<eventArgs>...?
534#
535# Used internally to update the layout of panes whenever a new pane
536# is added or a sash is moved.
537# ----------------------------------------------------------------------
538itcl::body Rappture::SidebarFrame::_fixLayout {args} {
539    set w [winfo width $itk_component(hull)]
540    set h [winfo height $itk_component(hull)]
541
542    set sashw [winfo reqwidth $itk_component(sashbg)]
543
544    set tabw [winfo reqwidth $itk_component(tabs)]
545    set btnw [winfo reqwidth $itk_component(controls)]
546    set ctrlw [expr {($tabw > $btnw) ? $tabw : $btnw}]
547
548    if {$_state == "closed"} {
549        set sbarw $ctrlw
550    } else {
551        if {$_width == "auto"} {
552            # pop open to the size of the widest pane
553            set sbarw 0
554            foreach pname $_panels(all) {
555                set pw [winfo reqwidth $itk_component($pname)]
556                if {$pw > $sbarw} {
557                    set sbarw $pw
558                }
559            }
560            set sbarw [expr {$sbarw + $ctrlw + $sashw}]
561        } else {
562            set sbarw $_width
563        }
564    }
565
566    # don't let the sidebar take up too much of the window area
567    if {$sbarw > 0.75*$w} {
568        set sbarw [expr {int(0.75*$w)}]
569    }
570
571    set x1 [expr {$w - $sbarw - $sashw}]
572    set x2 [expr {$w - $sbarw}]
573    if { $resizeframe } {
574        set framew $x1
575    } else {
576        set framew [expr $w - $ctrlw - $sashw]
577    }
578    place $itk_component(frame) -x 0 -y 0 -anchor nw -width $framew -height $h
579    place $itk_component(sashbg) -x $x1 -y 0 -anchor nw -width $sashw -height $h
580    place $itk_component(sidebar) -x $x2 -y 0 -anchor nw \
581        -width $sbarw -height $h
582}
583
584# ----------------------------------------------------------------------
585# CONFIGURATION OPTION: -sashpadding
586# ----------------------------------------------------------------------
587itcl::configbody Rappture::SidebarFrame::sashpadding {
588    pack $itk_component(sash) -padx $itk_option(-sashpadding)
589}
590
591# ----------------------------------------------------------------------
592# CONFIGURATION OPTION: -sashcolor
593# ----------------------------------------------------------------------
594itcl::configbody Rappture::SidebarFrame::sashcolor {
595    if {$itk_option(-sashcolor) != ""} {
596        $itk_component(sash) configure -background $itk_option(-sashcolor)
597    } else {
598        $itk_component(sash) configure -background $itk_option(-background)
599    }
600}
601
Note: See TracBrowser for help on using the repository browser.