source: branches/blt4/gui/scripts/sidebarframe.tcl

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

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