source: branches/blt4_trunk/gui/scripts/sidebarframe.tcl @ 6136

Last change on this file since 6136 was 6136, checked in by dkearney, 8 years ago

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