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

Last change on this file since 11 was 11, checked in by mmc, 16 years ago

Major reorganization of the entire package. The config.xml file
is now irrelevant. All the action is in the tool.xml file. The
main program now organizes all input into 1) side-by-side pages,
2) input/result (wizard-style) pages, or 3) a series of wizard-
style pages. The <input> can have <phase> parts representing
the various pages.

Added a new ContourResult? widget based on Swaroop's vtk plotting
code.

Also, added easymesh and showmesh to the "tools" directory.
We need these for Eric Polizzi's code.

File size: 10.7 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
13
14option add *Controls.padding 4 widgetDefault
15option add *Controls.labelFont \
16    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
17
18itcl::class Rappture::Controls {
19    inherit itk::Widget
20
21    itk_option define -padding padding Padding 0
22
23    constructor {tool args} { # defined below }
24
25    public method insert {pos xmlobj path}
26    public method delete {first {last ""}}
27    public method index {name}
28    public method control {args}
29
30    protected method _layout {}
31    protected method _controlChanged {path}
32    protected method _formatLabel {str}
33
34    private variable _tool ""        ;# controls belong to this tool
35    private variable _counter 0      ;# counter for control names
36    private variable _dispatcher ""  ;# dispatcher for !events
37    private variable _controls ""    ;# list of known controls
38    private variable _name2info      ;# maps control name => info
39}
40                                                                               
41itk::usual Controls {
42}
43
44# ----------------------------------------------------------------------
45# CONSTRUCTOR
46# ----------------------------------------------------------------------
47itcl::body Rappture::Controls::constructor {tool args} {
48    Rappture::dispatcher _dispatcher
49    $_dispatcher register !layout
50    $_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
51
52    set _tool $tool
53
54    eval itk_initialize $args
55}
56
57# ----------------------------------------------------------------------
58# USAGE: insert <pos> <xmlobj> <path>
59#
60# Clients use this to insert a control into this panel.  The control
61# is inserted into the list at position <pos>, which can be an integer
62# starting from 0 or the keyword "end".  Information about the control
63# is taken from the <xmlobj> object at the specified <path>.
64#
65# Returns a name that can be used to identify the control in other
66# methods.
67# ----------------------------------------------------------------------
68itcl::body Rappture::Controls::insert {pos xmlobj path} {
69    if {"end" == $pos} {
70        set pos [llength $_controls]
71    } elseif {![string is integer $pos]} {
72        error "bad index \"$pos\": should be integer or \"end\""
73    }
74
75    incr _counter
76    set name "control$_counter"
77
78    set _name2info($name-xmlobj) $xmlobj
79    set _name2info($name-path) $path
80    set _name2info($name-label) ""
81    set _name2info($name-value) [set w $itk_interior.v$name]
82
83    set type [$xmlobj element -as type $path]
84    switch -- $type {
85        choice {
86            Rappture::ChoiceEntry $w $xmlobj $path
87            bind $w <<Value>> [itcl::code $this _controlChanged $path]
88        }
89        group {
90            Rappture::GroupEntry $w $xmlobj $path
91        }
92        loader {
93            Rappture::Loader $w $xmlobj $path -tool $_tool
94            bind $w <<Value>> [itcl::code $this _controlChanged $path]
95        }
96        number {
97            Rappture::NumberEntry $w $xmlobj $path
98            bind $w <<Value>> [itcl::code $this _controlChanged $path]
99        }
100        string {
101            Rappture::TextEntry $w $xmlobj $path
102            bind $w <<Value>> [itcl::code $this _controlChanged $path]
103        }
104        default {
105            error "don't know how to add control type \"$type\""
106        }
107    }
108    $_tool widgetfor $path $w
109
110    # make a label for this control
111    set label [$w label]
112    if {"" != $label} {
113        set _name2info($name-label) $itk_interior.l$name
114        set font [option get $itk_component(hull) labelFont Font]
115        label $_name2info($name-label) -text [_formatLabel $label] \
116            -font $font
117    }
118
119    # register the tooltip for this control
120    set tip [$w tooltip]
121    if {"" != $tip} {
122        Rappture::Tooltip::for $w $tip
123
124        # add the tooltip to the label too, if there is one
125        if {$_name2info($name-label) != ""} {
126            Rappture::Tooltip::for $_name2info($name-label) $tip
127        }
128    }
129
130    # insert the new control onto the known list
131    set _controls [linsert $_controls $pos $name]
132
133    # now that we have a new control, we should fix the layout
134    $_dispatcher event -idle !layout
135
136    return $name
137}
138
139# ----------------------------------------------------------------------
140# USAGE: delete <first> ?<last>?
141#
142# Clients use this to delete one or more controls from this widget.
143# The <first> and <last> represent the integer index of the desired
144# control.  You can use the "index" method to convert a control name to
145# its integer index.  If only <first> is specified, then that one
146# control is deleted.  If <last> is specified, then all controls in the
147# range <first> to <last> are deleted.
148# ----------------------------------------------------------------------
149itcl::body Rappture::Controls::delete {first {last ""}} {
150    if {$last == ""} {
151        set last $first
152    }
153    if {![regexp {^[0-9]+|end$} $first]} {
154        error "bad index \"$first\": should be integer or \"end\""
155    }
156    if {![regexp {^[0-9]+|end$} $last]} {
157        error "bad index \"$last\": should be integer or \"end\""
158    }
159
160    foreach name [lrange $_controls $first $last] {
161        if {"" != $_name2info($name-label)} {
162            destroy $_name2info($name-label)
163        }
164        if {"" != $_name2info($name-value)} {
165            destroy $_name2info($name-value)
166        }
167        unset _name2info($name-xmlobj)
168        unset _name2info($name-path)
169        unset _name2info($name-label)
170        unset _name2info($name-value)
171    }
172    set _controls [lreplace $_controls $first $last]
173
174    $_dispatcher event -idle !layout
175}
176
177# ----------------------------------------------------------------------
178# USAGE: index <name>|@n
179#
180# Clients use this to convert a control <name> into its corresponding
181# integer index.  Returns an error if the <name> is not recognized.
182# ----------------------------------------------------------------------
183itcl::body Rappture::Controls::index {name} {
184    set i [lsearch $_controls $name]
185    if {$i >= 0} {
186        return $i
187    }
188    if {[regexp {^@([0-9]+)$} $name match i]} {
189        return $i
190    }
191    error "bad control name \"$name\": should be @int or one of [join [lsort $_controls] {, }]"
192}
193
194# ----------------------------------------------------------------------
195# USAGE: control ?-label|-value|-xmlobj|-path? ?<name>|@n?
196#
197# Clients use this to get information about controls.  With no args, it
198# returns a list of all control names.  Otherwise, it returns the frame
199# associated with a control name.  The -label option requests the label
200# widget instead of the value widget.  The -xmlobj option requests the
201# XML object associated with the control, and the -path option requests
202# the path within the XML that the control affects.
203# ----------------------------------------------------------------------
204itcl::body Rappture::Controls::control {args} {
205    if {[llength $args] == 0} {
206        return $_controls
207    }
208    Rappture::getopts args params {
209        flag switch -value default
210        flag switch -label
211        flag switch -xmlobj
212        flag switch -path
213    }
214    if {[llength $args] == 0} {
215        error "missing control name"
216    }
217    set i [index [lindex $args 0]]
218    set name [lindex $_controls $i]
219
220    set opt $params(switch)
221    return $_name2info($name$opt)
222}
223
224# ----------------------------------------------------------------------
225# USAGE: _layout
226#
227# Used internally to fix the layout of controls whenever controls
228# are added or deleted, or when the control arrangement changes.
229# There are a lot of heuristics here trying to achieve a "good"
230# arrangement of controls.
231# ----------------------------------------------------------------------
232itcl::body Rappture::Controls::_layout {} {
233    #
234    # Clear any existing layout
235    #
236    foreach name $_controls {
237        foreach elem {label value} {
238            set w $_name2info($name-$elem)
239            if {$w != "" && [winfo exists $w]} {
240                grid forget $w
241            }
242        }
243    }
244
245    #
246    # Lay out the widgets in a simple "Label: Value" scheme...
247    #
248    set row 0
249    foreach name $_controls {
250        set wl $_name2info($name-label)
251        if {$wl != "" && [winfo exists $wl]} {
252            grid $wl -row $row -column 0 -sticky e
253        }
254
255        set wv $_name2info($name-value)
256        if {$wv != "" && [winfo exists $wv]} {
257            grid $wv -row $row -column 1 -sticky ew
258
259            set frame [winfo parent $wv]
260            grid rowconfigure $frame $row -weight 0
261            grid rowconfigure $frame $row -weight 0
262
263            switch -- [winfo class $wv] {
264                TextEntry {
265                    if {[regexp {[0-9]+x[0-9]+} [$wv size]]} {
266                        grid $wl -sticky n -pady 4
267                        grid $wv -sticky nsew
268                        grid rowconfigure $frame $row -weight 1
269                        grid columnconfigure $frame 1 -weight 1
270                    }
271                }
272            }
273            grid columnconfigure $frame 1 -weight 1
274        }
275
276
277        incr row
278        grid rowconfigure [winfo parent $w] $row -minsize $itk_option(-padding)
279        incr row
280    }
281}
282
283# ----------------------------------------------------------------------
284# USAGE: _controlChanged <path>
285#
286# Invoked automatically whenever the value for the control with the
287# XML <path> changes.  Sends a notification along to the tool
288# controlling this panel.
289# ----------------------------------------------------------------------
290itcl::body Rappture::Controls::_controlChanged {path} {
291    if {"" != $_tool} {
292        $_tool changed $path
293    }
294}
295
296# ----------------------------------------------------------------------
297# USAGE: _formatLabel <string>
298#
299# Used internally to format a label <string>.  Trims any excess
300# white space and adds a ":" to the end.  That way, all labels
301# have a uniform look.
302# ----------------------------------------------------------------------
303itcl::body Rappture::Controls::_formatLabel {str} {
304    set str [string trim $str]
305    if {"" != $str && [string index $str end] != ":"} {
306        append str ":"
307    }
308    return $str
309}
310
311# ----------------------------------------------------------------------
312# OPTION: -padding
313# ----------------------------------------------------------------------
314itcl::configbody Rappture::Controls::padding {
315    $_dispatcher event -idle !layout
316}
Note: See TracBrowser for help on using the repository browser.