source: trunk/gui/scripts/controls.tcl @ 26

Last change on this file since 26 was 26, checked in by mmc, 17 years ago

Fixed the rendering of groups, and groups within groups.
If groups are mixed in with other elements, then they are
drawn with a gray outline/heading, with the title taken
from the <group><about><label>. However, if a group
contains only other groups, then it is treated as a tabbed
notebook, and each group within is put on a separate page.

WARNING: There are many bad interactions between the
blt::tabset, the Rappture::Scroller, and the Rappture::Pager.
Pages shake violently when all are in play. The only way I
could get them to settle down was by putting the tabs above
the pages they control. Have to revisit this some time to
make it look better...

File size: 15.0 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: controls - a container for various Rappture controls
3#
4#  This widget is a smart frame acting as a container for controls.
5#  Controls are added to this panel, and the panel itself decides
6#  how to arrange them given available space.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2005
10#  Purdue Research Foundation, West Lafayette, IN
11# ======================================================================
12package require Itk
13package require BLT
14
15option add *Controls.padding 4 widgetDefault
16option add *Controls.labelFont \
17    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
18
19itcl::class Rappture::Controls {
20    inherit itk::Widget
21
22    itk_option define -padding padding Padding 0
23
24    constructor {owner args} { # defined below }
25
26    public method insert {pos path}
27    public method delete {first {last ""}}
28    public method index {name}
29    public method control {args}
30
31    protected method _layout {}
32    protected method _controlChanged {path}
33    protected method _formatLabel {str}
34    protected method _changeTabs {}
35
36    private variable _owner ""       ;# controls belong to this owner
37    private variable _tabs ""        ;# optional tabset for groups
38    private variable _frame ""       ;# pack controls into this frame
39    private variable _counter 0      ;# counter for control names
40    private variable _dispatcher ""  ;# dispatcher for !events
41    private variable _controls ""    ;# list of known controls
42    private variable _name2info      ;# maps control name => info
43}
44                                                                               
45itk::usual Controls {
46}
47
48# ----------------------------------------------------------------------
49# CONSTRUCTOR
50# ----------------------------------------------------------------------
51itcl::body Rappture::Controls::constructor {owner args} {
52    Rappture::dispatcher _dispatcher
53    $_dispatcher register !layout
54    $_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
55
56    set _owner $owner
57
58    Rappture::Scroller $itk_interior.sc -xscrollmode none -yscrollmode auto
59    pack $itk_interior.sc -expand yes -fill both
60    set f [$itk_interior.sc contents frame]
61
62    set _tabs [blt::tabset $f.tabs -borderwidth 0 -relief flat \
63        -side top -tearoff 0 -highlightthickness 0 \
64        -selectbackground $itk_option(-background) \
65        -selectcommand [itcl::code $this _changeTabs]]
66
67    set _frame [frame $f.inner]
68    pack $_frame -expand yes -fill both
69
70    eval itk_initialize $args
71}
72
73# ----------------------------------------------------------------------
74# USAGE: insert <pos> <path>
75#
76# Clients use this to insert a control into this panel.  The control
77# is inserted into the list at position <pos>, which can be an integer
78# starting from 0 or the keyword "end".  Information about the control
79# is taken from the specified <path>.
80#
81# Returns a name that can be used to identify the control in other
82# methods.
83# ----------------------------------------------------------------------
84itcl::body Rappture::Controls::insert {pos path} {
85    if {"end" == $pos} {
86        set pos [llength $_controls]
87    } elseif {![string is integer $pos]} {
88        error "bad index \"$pos\": should be integer or \"end\""
89    }
90
91    incr _counter
92    set name "control$_counter"
93
94    set _name2info($name-path) $path
95    set _name2info($name-label) ""
96    set _name2info($name-value) [set w $_frame.v$name]
97
98    set type [$_owner xml element -as type $path]
99    switch -- $type {
100        choice {
101            Rappture::ChoiceEntry $w $_owner $path
102            bind $w <<Value>> [itcl::code $this _controlChanged $path]
103        }
104        group {
105            Rappture::GroupEntry $w $_owner $path
106        }
107        loader {
108            Rappture::Loader $w $_owner $path -tool [$_owner tool]
109            bind $w <<Value>> [itcl::code $this _controlChanged $path]
110        }
111        number {
112            Rappture::NumberEntry $w $_owner $path
113            bind $w <<Value>> [itcl::code $this _controlChanged $path]
114        }
115        integer {
116            Rappture::IntegerEntry $w $_owner $path
117            bind $w <<Value>> [itcl::code $this _controlChanged $path]
118        }
119        boolean {
120            Rappture::BooleanEntry $w $_owner $path
121            bind $w <<Value>> [itcl::code $this _controlChanged $path]
122        }
123        string {
124            Rappture::TextEntry $w $_owner $path
125            bind $w <<Value>> [itcl::code $this _controlChanged $path]
126        }
127        control {
128            set label [$_owner xml get $path.label]
129            if {"" == $label} { set label "Simulate" }
130            set service [$_owner xml get $path.service]
131            button $w -text $label -command [list $service run]
132        }
133        default {
134            error "don't know how to add control type \"$type\""
135        }
136    }
137
138    if {$type != "control"} {
139        $_owner widgetfor $path $w
140
141        # make a label for this control
142        set label [$w label]
143        if {"" != $label} {
144            set _name2info($name-label) $_frame.l$name
145            set font [option get $itk_component(hull) labelFont Font]
146            label $_name2info($name-label) -text [_formatLabel $label] \
147                -font $font
148        }
149
150        # register the tooltip for this control
151        set tip [$w tooltip]
152        if {"" != $tip} {
153            Rappture::Tooltip::for $w $tip
154
155            # add the tooltip to the label too, if there is one
156            if {$_name2info($name-label) != ""} {
157                Rappture::Tooltip::for $_name2info($name-label) $tip
158            }
159        }
160    }
161
162    # insert the new control onto the known list
163    set _controls [linsert $_controls $pos $name]
164
165    # now that we have a new control, we should fix the layout
166    $_dispatcher event -idle !layout
167
168    return $name
169}
170
171# ----------------------------------------------------------------------
172# USAGE: delete <first> ?<last>?
173#
174# Clients use this to delete one or more controls from this widget.
175# The <first> and <last> represent the integer index of the desired
176# control.  You can use the "index" method to convert a control name to
177# its integer index.  If only <first> is specified, then that one
178# control is deleted.  If <last> is specified, then all controls in the
179# range <first> to <last> are deleted.
180# ----------------------------------------------------------------------
181itcl::body Rappture::Controls::delete {first {last ""}} {
182    if {$last == ""} {
183        set last $first
184    }
185    if {![regexp {^[0-9]+|end$} $first]} {
186        error "bad index \"$first\": should be integer or \"end\""
187    }
188    if {![regexp {^[0-9]+|end$} $last]} {
189        error "bad index \"$last\": should be integer or \"end\""
190    }
191
192    foreach name [lrange $_controls $first $last] {
193        if {"" != $_name2info($name-label)} {
194            destroy $_name2info($name-label)
195        }
196        if {"" != $_name2info($name-value)} {
197            destroy $_name2info($name-value)
198        }
199        $_owner widgetfor $_name2info($name-path) ""
200
201        unset _name2info($name-path)
202        unset _name2info($name-label)
203        unset _name2info($name-value)
204    }
205    set _controls [lreplace $_controls $first $last]
206
207    $_dispatcher event -idle !layout
208}
209
210# ----------------------------------------------------------------------
211# USAGE: index <name>|@n
212#
213# Clients use this to convert a control <name> into its corresponding
214# integer index.  Returns an error if the <name> is not recognized.
215# ----------------------------------------------------------------------
216itcl::body Rappture::Controls::index {name} {
217    set i [lsearch $_controls $name]
218    if {$i >= 0} {
219        return $i
220    }
221    if {[regexp {^@([0-9]+)$} $name match i]} {
222        return $i
223    }
224    error "bad control name \"$name\": should be @int or one of [join [lsort $_controls] {, }]"
225}
226
227# ----------------------------------------------------------------------
228# USAGE: control ?-label|-value|-path? ?<name>|@n?
229#
230# Clients use this to get information about controls.  With no args, it
231# returns a list of all control names.  Otherwise, it returns the frame
232# associated with a control name.  The -label option requests the label
233# widget instead of the value widget.  The -path option requests the
234# path within the XML that the control affects.
235# ----------------------------------------------------------------------
236itcl::body Rappture::Controls::control {args} {
237    if {[llength $args] == 0} {
238        return $_controls
239    }
240    Rappture::getopts args params {
241        flag switch -value default
242        flag switch -label
243        flag switch -path
244    }
245    if {[llength $args] == 0} {
246        error "missing control name"
247    }
248    set i [index [lindex $args 0]]
249    set name [lindex $_controls $i]
250
251    set opt $params(switch)
252    return $_name2info($name$opt)
253}
254
255# ----------------------------------------------------------------------
256# USAGE: _layout
257#
258# Used internally to fix the layout of controls whenever controls
259# are added or deleted, or when the control arrangement changes.
260# There are a lot of heuristics here trying to achieve a "good"
261# arrangement of controls.
262# ----------------------------------------------------------------------
263itcl::body Rappture::Controls::_layout {} {
264    #
265    # Clear any existing layout
266    #
267    foreach name $_controls {
268        foreach elem {label value} {
269            set w $_name2info($name-$elem)
270            if {$w != "" && [winfo exists $w]} {
271                grid forget $w
272            }
273        }
274    }
275    if {[$_tabs size] > 0} {
276        $_tabs delete 0 end
277    }
278
279    #
280    # Decide on a layout scheme:
281    #   tabs ...... best if all elements within are groups
282    #   hlabels ... horizontal labels (label: value)
283    #
284    if {[llength $_controls] >= 2} {
285        # assume tabs for multiple groups
286        set scheme tabs
287        foreach name $_controls {
288            set w $_name2info($name-value)
289
290            if {[winfo class $w] != "GroupEntry"} {
291                # something other than a group? then fall back on hlabels
292                set scheme hlabels
293                break
294            }
295        }
296    } else {
297        set scheme hlabels
298    }
299
300    switch -- $scheme {
301      tabs {
302        #
303        # SCHEME: tabs
304        # put a series of groups into a tabbed notebook
305        #
306
307        # use inner frame within tabs to show current group
308        pack $_tabs -before $_frame -fill x
309
310        set gn 1
311        foreach name $_controls {
312            set wv $_name2info($name-value)
313            $wv configure -heading no
314
315            set label [$wv component heading cget -text]
316            if {"" == $label} {
317                set label "Group #$gn"
318            }
319            set _name2info($name-label) $label
320
321            $_tabs insert end $label \
322                -activebackground $itk_option(-background)
323
324            incr gn
325        }
326
327        # compute the overall size
328        # BE CAREFUL: do this after setting "-heading no" above
329        set maxw 0
330        set maxh 0
331        update idletasks
332        foreach name $_controls {
333            set w [winfo reqwidth $wv]
334            if {$w > $maxw} { set maxw $w }
335            set h [winfo reqheight $wv]
336            if {$h > $maxh} { set maxh $h }
337        }
338        $_frame configure -width $maxw -height $maxh
339
340        grid propagate $_frame off
341        grid columnconfigure $_frame 0 -weight 1
342        grid rowconfigure $_frame 0 -weight 1
343
344        $_tabs select 0; _changeTabs
345      }
346
347      hlabels {
348        #
349        # SCHEME: hlabels
350        # simple "Label: Value" layout
351        #
352        pack forget $_tabs
353        grid propagate $_frame on
354        grid columnconfigure $_frame 0 -weight 0
355        grid rowconfigure $_frame 0 -weight 0
356
357        set row 0
358        foreach name $_controls {
359            set wl $_name2info($name-label)
360            if {$wl != "" && [winfo exists $wl]} {
361                grid $wl -row $row -column 0 -sticky e
362            }
363
364            set wv $_name2info($name-value)
365            if {$wv != "" && [winfo exists $wv]} {
366                if {$wl != ""} {
367                    grid $wv -row $row -column 1 -sticky ew
368                } else {
369                    grid $wv -row $row -column 0 -columnspan 2 -sticky ew
370                }
371
372                set frame [winfo parent $wv]
373                grid rowconfigure $frame $row -weight 0
374                grid rowconfigure $frame $row -weight 0
375
376                switch -- [winfo class $wv] {
377                    TextEntry {
378                        if {[regexp {[0-9]+x[0-9]+} [$wv size]]} {
379                            grid $wl -sticky n -pady 4
380                            grid $wv -sticky nsew
381                            grid rowconfigure $frame $row -weight 1
382                            grid columnconfigure $frame 1 -weight 1
383                        }
384                    }
385                    GroupEntry {
386                        $wv configure -heading yes
387                    }
388                }
389                grid columnconfigure $frame 1 -weight 1
390            }
391
392
393            incr row
394            grid rowconfigure [winfo parent $w] $row \
395                -minsize $itk_option(-padding)
396            incr row
397        }
398      }
399    }
400}
401
402# ----------------------------------------------------------------------
403# USAGE: _controlChanged <path>
404#
405# Invoked automatically whenever the value for the control with the
406# XML <path> changes.  Sends a notification along to the tool
407# controlling this panel.
408# ----------------------------------------------------------------------
409itcl::body Rappture::Controls::_controlChanged {path} {
410    if {"" != $_owner} {
411        $_owner changed $path
412    }
413}
414
415# ----------------------------------------------------------------------
416# USAGE: _formatLabel <string>
417#
418# Used internally to format a label <string>.  Trims any excess
419# white space and adds a ":" to the end.  That way, all labels
420# have a uniform look.
421# ----------------------------------------------------------------------
422itcl::body Rappture::Controls::_formatLabel {str} {
423    set str [string trim $str]
424    if {"" != $str && [string index $str end] != ":"} {
425        append str ":"
426    }
427    return $str
428}
429
430# ----------------------------------------------------------------------
431# USAGE: _changeTabs
432#
433# Used internally to change tabs when the user clicks on a tab
434# in the "tabs" layout mode.  This mode is used when the widget
435# contains nothing but groups, as a compact way of representing
436# the groups.
437# ----------------------------------------------------------------------
438itcl::body Rappture::Controls::_changeTabs {} {
439    set i [$_tabs index select]
440    set name [lindex $_controls $i]
441    if {"" != $name} {
442        foreach w [grid slaves $_frame] {
443            grid forget $w
444        }
445
446        set wv $_name2info($name-value)
447        grid $wv -row 0 -column 0 -sticky new
448    }
449}
450
451# ----------------------------------------------------------------------
452# OPTION: -padding
453# ----------------------------------------------------------------------
454itcl::configbody Rappture::Controls::padding {
455    $_dispatcher event -idle !layout
456}
Note: See TracBrowser for help on using the repository browser.