source: trunk/gui/scripts/scroller.tcl @ 95

Last change on this file since 95 was 95, checked in by mmc, 17 years ago
  • Fixed an annoying bug in the scroller that would cause the device to jitter up and down in some cases. (1-barrier case of app-rtd)
  • Fixed cloud/mesh objects to allow different units for each of the various axes.
  • Fixed the install.tcl script to avoid popping up the notice about Rappture being installed when tclsh is running the script.
File size: 11.6 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: scroller - adds scrollbars to any standard Tk widget
3#
4#  This widget provides automatic scrollbars for any standard Tk
5#  widget.  The scrolled widget should be created as a child of this
6#  widget, and is connected by calling the "contents" method.  Calling
7#  contents with the keyword "frame" creates an internal frame that
8#  allows any collection of widgets to be scrolled.
9# ======================================================================
10#  AUTHOR:  Michael McLennan, Purdue University
11#  Copyright (c) 2004-2005
12#  Purdue Research Foundation, West Lafayette, IN
13# ======================================================================
14package require Itk
15
16option add *Scroller.xScrollMode off widgetDefault
17option add *Scroller.yScrollMode auto widgetDefault
18option add *Scroller.width 0 widgetDefault
19option add *Scroller.height 0 widgetDefault
20
21itcl::class Rappture::Scroller {
22    inherit itk::Widget
23
24    itk_option define -xscrollmode xScrollMode XScrollMode ""
25    itk_option define -yscrollmode yScrollMode YScrollMode ""
26    itk_option define -width width Width 0
27    itk_option define -height height Height 0
28
29    constructor {args} { # defined below }
30
31    public method contents {{frame "!@#query"}}
32
33    protected method _widget2sbar {which args}
34    protected method _fixsbar {which {state ""}}
35    protected method _fixframe {which}
36    protected method _fixsize {}
37    protected method _lock {option which}
38
39    private variable _dispatcher "" ;# dispatcher for !events
40    private variable _contents ""   ;# widget being controlled
41    private variable _frame ""      ;# for "contents frame" calls
42    private variable _lock          ;# for _lock on x/y scrollbar
43}
44                                                                               
45itk::usual Scroller {
46    keep -background -activebackground -activerelief
47    keep -cursor
48    keep -highlightcolor -highlightthickness
49    keep -troughcolor
50}
51
52# ----------------------------------------------------------------------
53# CONSTRUCTOR
54# ----------------------------------------------------------------------
55itcl::body Rappture::Scroller::constructor {args} {
56    array set _lock { x 0 y 0 }
57
58    Rappture::dispatcher _dispatcher
59
60    $_dispatcher register !fixframe-inner
61    $_dispatcher dispatch $this !fixframe-inner \
62        "[itcl::code $this _fixframe inner]; list"
63
64    $_dispatcher register !fixframe-outer
65    $_dispatcher dispatch $this !fixframe-outer \
66        "[itcl::code $this _fixframe outer]; list"
67
68    $_dispatcher register !fixsize
69    $_dispatcher dispatch $this !fixsize \
70        "[itcl::code $this _fixsize]; list"
71
72    itk_component add xsbar {
73        scrollbar $itk_interior.xsbar -orient horizontal
74    }
75    itk_component add ysbar {
76        scrollbar $itk_interior.ysbar -orient vertical
77    }
78
79    grid rowconfigure $itk_component(hull) 0 -weight 1
80    grid columnconfigure $itk_component(hull) 0 -weight 1
81
82    eval itk_initialize $args
83}
84
85# ----------------------------------------------------------------------
86# USAGE: contents ?<widget>|frame?
87#
88# Used to get/set the widget that is being scrolled.  With no args,
89# it returns the name of the widget currently connected to the
90# scrollbars.  Otherwise, the argument specifies a widget to be
91# controlled by the scrollbar.  If the argument is the keyword
92# "frame", then this method creates its own internal frame, which
93# can be packed with other widgets, and returns its name.
94# ----------------------------------------------------------------------
95itcl::body Rappture::Scroller::contents {{widget "!@#query"}} {
96    if {$widget == "!@#query"} {
97        return $_contents
98    }
99
100    #
101    # If the widget is "", then unhook any existing widget.
102    #
103    if {$widget == ""} {
104        if {$_contents != ""} {
105            $_contents configure -xscrollcommand "" -yscrollcommand ""
106            grid forget $_contents
107        }
108        $itk_component(xsbar) configure -command ""
109        $itk_component(ysbar) configure -command ""
110        set _contents ""
111
112        return ""
113    }
114
115    #
116    # For the "frame" keyword, create a canvas that can be scrolled
117    # and return it as the frame being scrolled.
118    #
119    if {$widget == "frame"} {
120        if {$_frame == ""} {
121            set _frame [canvas $itk_component(hull).ifr -highlightthickness 0]
122            frame $_frame.f
123            $_frame create window 0 0 -anchor nw -window $_frame.f -tags frame
124            bind $_frame.f <Configure> \
125                [itcl::code $_dispatcher event -idle !fixframe-inner]
126            bind $_frame <Configure> \
127                [itcl::code $_dispatcher event -idle !fixframe-outer]
128        }
129        set widget $_frame
130    }
131
132    #
133    # Plug the specified widget into the scrollbars for this widget.
134    #
135    contents ""
136    grid $widget -row 0 -column 0 -sticky nsew
137    $widget configure \
138        -xscrollcommand [itcl::code $this _widget2sbar x] \
139        -yscrollcommand [itcl::code $this _widget2sbar y]
140
141    $itk_component(xsbar) configure -command [list $widget xview]
142    $itk_component(ysbar) configure -command [list $widget yview]
143    set _contents $widget
144
145    if {$widget == $_frame} {
146        return $_frame.f
147    }
148    return $widget
149}
150
151# ----------------------------------------------------------------------
152# USAGE: _widget2sbar <which> ?args...?
153#
154# Used internally to handle communication from the widget to the
155# scrollbar.  If the scrollbars are in "auto" mode, this provides a
156# hook where we can fix their display.
157# ----------------------------------------------------------------------
158itcl::body Rappture::Scroller::_widget2sbar {which args} {
159    if {$itk_option(-xscrollmode) == "auto"} {
160        _fixsbar x
161    }
162    if {$itk_option(-yscrollmode) == "auto"} {
163        _fixsbar y
164    }
165    eval $itk_component(${which}sbar) set $args
166}
167
168# ----------------------------------------------------------------------
169# USAGE: _fixsbar <which> ?<state>?
170#
171# Used internally to show/hide the scrollbar in the <which> direction,
172# which is either "x" or "y".  If the scrollbar is "on", then it is
173# always displayed.  If "off", never displayed.  And if "auto", then
174# it is displayed if needed for the current view.
175# ----------------------------------------------------------------------
176itcl::body Rappture::Scroller::_fixsbar {which {state ""}} {
177    if {$state == ""} {
178        switch -- [string tolower $itk_option(-${which}scrollmode)] {
179            on - 1 - true - yes  { set state 1 }
180            off - 0 - false - no { set state 0 }
181            auto {
182                set state 0
183                if {$_contents != ""} {
184                    set lims [$_contents ${which}view]
185                    if {[lindex $lims 0] != 0 || [lindex $lims 1] != 1} {
186                        set state 1
187                    }
188                }
189            }
190            default {
191                set state 0
192            }
193        }
194    }
195
196    # show/hide the scrollbar depending on the desired state
197    switch -- $which {
198        x {
199            if {$state} {
200                if {![_lock active x]} {
201                    grid $itk_component(xsbar) -row 1 -column 0 -sticky ew
202                }
203            } else {
204                grid forget $itk_component(xsbar)
205                _lock set x
206            }
207        }
208        y {
209            if {$state} {
210                if {![_lock active y]} {
211                    grid $itk_component(ysbar) -row 0 -column 1 -sticky ns
212                }
213            } else {
214                grid forget $itk_component(ysbar)
215                _lock set y
216            }
217        }
218    }
219}
220
221# ----------------------------------------------------------------------
222# USAGE: _fixframe <which>
223#
224# Invoked automatically whenever the canvas representing the "frame"
225# keyword is resized.  Updates the scrolling limits for the canvas
226# to the new size.
227# ----------------------------------------------------------------------
228itcl::body Rappture::Scroller::_fixframe {which} {
229    switch -- $which {
230        inner {
231            $_frame configure -scrollregion [$_frame bbox all]
232            $_dispatcher event -idle !fixsize
233        }
234        outer {
235            $_frame itemconfigure frame -width [winfo width $_frame]
236            if {[winfo height $_frame] > [winfo reqheight $_frame.f]} {
237                $_frame itemconfigure frame -height [winfo height $_frame]
238            } else {
239                $_frame itemconfigure frame -height 0
240            }
241        }
242    }
243}
244
245# ----------------------------------------------------------------------
246# USAGE: _fixsize
247#
248# Used internally to update the size options for the widget
249# whenever the -width/-height options change.
250# ----------------------------------------------------------------------
251itcl::body Rappture::Scroller::_fixsize {} {
252    if {$itk_option(-width) == "0" && $itk_option(-height) == "0"} {
253        # for default size, let the frame being controlled set the size
254        grid propagate $itk_component(hull) yes
255        if {$_frame == "$itk_component(hull).ifr"} {
256            set w [winfo reqwidth $_frame.f]
257            set h [winfo reqheight $_frame.f]
258            $_frame configure -width $w -height $h
259        }
260    } else {
261        # for specific size, set the overall size of the widget
262        grid propagate $itk_component(hull) no
263        set w $itk_option(-width); if {$w == "0"} { set w 1i }
264        set h $itk_option(-height); if {$h == "0"} { set h 1i }
265        component hull configure -width $w -height $h
266    }
267}
268
269# ----------------------------------------------------------------------
270# USAGE: _lock set <which>
271# USAGE: _lock reset <which>
272# USAGE: _lock active <which>
273#
274# Used internally to lock out vibrations when the x-scrollbar pops
275# into view.  When the x-scrollbar pops up, it reduces the space
276# available for the widget.  For some widgets (e.g., text widget)
277# this changes the view.  A long line may fall off screen, and the
278# x-scrollbar will no longer be necessary.  If the x-scrollbar just
279# appeared, then its lock is active, signalling that it should stay
280# up.
281# ----------------------------------------------------------------------
282itcl::body Rappture::Scroller::_lock {option which} {
283    switch -- $option {
284        set {
285            set _lock($which) 1
286            after cancel [itcl::code $this _lock reset $which]
287            after 50 [itcl::code $this _lock reset $which]
288        }
289        reset {
290            set _lock($which) 0
291        }
292        active {
293            return $_lock($which)
294        }
295        default {
296            error "bad option \"$option\": should be set, reset, active"
297        }
298    }
299}
300
301# ----------------------------------------------------------------------
302# OPTION: -xscrollmode
303# ----------------------------------------------------------------------
304itcl::configbody Rappture::Scroller::xscrollmode {
305    _fixsbar x
306}
307
308# ----------------------------------------------------------------------
309# OPTION: -yscrollmode
310# ----------------------------------------------------------------------
311itcl::configbody Rappture::Scroller::yscrollmode {
312    _fixsbar y
313}
314
315# ----------------------------------------------------------------------
316# OPTION: -width
317# ----------------------------------------------------------------------
318itcl::configbody Rappture::Scroller::width {
319    # check for proper value
320    winfo pixels $itk_component(hull) $itk_option(-width)
321
322    $_dispatcher event -idle !fixsize
323}
324
325# ----------------------------------------------------------------------
326# OPTION: -height
327# ----------------------------------------------------------------------
328itcl::configbody Rappture::Scroller::height {
329    # check for proper value
330    winfo pixels $itk_component(hull) $itk_option(-height)
331
332    $_dispatcher event -idle !fixsize
333}
Note: See TracBrowser for help on using the repository browser.