source: branches/1.3/gui/scripts/sidebarframe.tcl @ 3785

Last change on this file since 3785 was 3785, checked in by gah, 8 years ago

fix multiple barchart results, fix PDB reader, dynamically create tabs for vtkviewer

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