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

Last change on this file since 1375 was 1375, checked in by mmc, 15 years ago

Created the SidebarFrame? widget to manage all sidebar options, and plugged
it into the various vis viewers and the xyresult.

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