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

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

Many improvements, including a new energy level viewer
for Huckel-IV. Added support for a new <boolean> type.
Fixed the cloud/field stuff so that when a cloud is 1D,
it reverts to BLT vectors so it will plot correctly.
Fixed the install script to work better on Windows.

File size: 10.8 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 {owner 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 _owner ""       ;# controls belong to this owner
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 {owner args} {
48    Rappture::dispatcher _dispatcher
49    $_dispatcher register !layout
50    $_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
51
52    set _owner $owner
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 [$_owner 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        boolean {
101            Rappture::BooleanEntry $w $xmlobj $path
102            bind $w <<Value>> [itcl::code $this _controlChanged $path]
103        }
104        string {
105            Rappture::TextEntry $w $xmlobj $path
106            bind $w <<Value>> [itcl::code $this _controlChanged $path]
107        }
108        default {
109            error "don't know how to add control type \"$type\""
110        }
111    }
112    $_owner widgetfor $path $w
113
114    # make a label for this control
115    set label [$w label]
116    if {"" != $label} {
117        set _name2info($name-label) $itk_interior.l$name
118        set font [option get $itk_component(hull) labelFont Font]
119        label $_name2info($name-label) -text [_formatLabel $label] \
120            -font $font
121    }
122
123    # register the tooltip for this control
124    set tip [$w tooltip]
125    if {"" != $tip} {
126        Rappture::Tooltip::for $w $tip
127
128        # add the tooltip to the label too, if there is one
129        if {$_name2info($name-label) != ""} {
130            Rappture::Tooltip::for $_name2info($name-label) $tip
131        }
132    }
133
134    # insert the new control onto the known list
135    set _controls [linsert $_controls $pos $name]
136
137    # now that we have a new control, we should fix the layout
138    $_dispatcher event -idle !layout
139
140    return $name
141}
142
143# ----------------------------------------------------------------------
144# USAGE: delete <first> ?<last>?
145#
146# Clients use this to delete one or more controls from this widget.
147# The <first> and <last> represent the integer index of the desired
148# control.  You can use the "index" method to convert a control name to
149# its integer index.  If only <first> is specified, then that one
150# control is deleted.  If <last> is specified, then all controls in the
151# range <first> to <last> are deleted.
152# ----------------------------------------------------------------------
153itcl::body Rappture::Controls::delete {first {last ""}} {
154    if {$last == ""} {
155        set last $first
156    }
157    if {![regexp {^[0-9]+|end$} $first]} {
158        error "bad index \"$first\": should be integer or \"end\""
159    }
160    if {![regexp {^[0-9]+|end$} $last]} {
161        error "bad index \"$last\": should be integer or \"end\""
162    }
163
164    foreach name [lrange $_controls $first $last] {
165        if {"" != $_name2info($name-label)} {
166            destroy $_name2info($name-label)
167        }
168        if {"" != $_name2info($name-value)} {
169            destroy $_name2info($name-value)
170        }
171        unset _name2info($name-xmlobj)
172        unset _name2info($name-path)
173        unset _name2info($name-label)
174        unset _name2info($name-value)
175    }
176    set _controls [lreplace $_controls $first $last]
177
178    $_dispatcher event -idle !layout
179}
180
181# ----------------------------------------------------------------------
182# USAGE: index <name>|@n
183#
184# Clients use this to convert a control <name> into its corresponding
185# integer index.  Returns an error if the <name> is not recognized.
186# ----------------------------------------------------------------------
187itcl::body Rappture::Controls::index {name} {
188    set i [lsearch $_controls $name]
189    if {$i >= 0} {
190        return $i
191    }
192    if {[regexp {^@([0-9]+)$} $name match i]} {
193        return $i
194    }
195    error "bad control name \"$name\": should be @int or one of [join [lsort $_controls] {, }]"
196}
197
198# ----------------------------------------------------------------------
199# USAGE: control ?-label|-value|-xmlobj|-path? ?<name>|@n?
200#
201# Clients use this to get information about controls.  With no args, it
202# returns a list of all control names.  Otherwise, it returns the frame
203# associated with a control name.  The -label option requests the label
204# widget instead of the value widget.  The -xmlobj option requests the
205# XML object associated with the control, and the -path option requests
206# the path within the XML that the control affects.
207# ----------------------------------------------------------------------
208itcl::body Rappture::Controls::control {args} {
209    if {[llength $args] == 0} {
210        return $_controls
211    }
212    Rappture::getopts args params {
213        flag switch -value default
214        flag switch -label
215        flag switch -xmlobj
216        flag switch -path
217    }
218    if {[llength $args] == 0} {
219        error "missing control name"
220    }
221    set i [index [lindex $args 0]]
222    set name [lindex $_controls $i]
223
224    set opt $params(switch)
225    return $_name2info($name$opt)
226}
227
228# ----------------------------------------------------------------------
229# USAGE: _layout
230#
231# Used internally to fix the layout of controls whenever controls
232# are added or deleted, or when the control arrangement changes.
233# There are a lot of heuristics here trying to achieve a "good"
234# arrangement of controls.
235# ----------------------------------------------------------------------
236itcl::body Rappture::Controls::_layout {} {
237    #
238    # Clear any existing layout
239    #
240    foreach name $_controls {
241        foreach elem {label value} {
242            set w $_name2info($name-$elem)
243            if {$w != "" && [winfo exists $w]} {
244                grid forget $w
245            }
246        }
247    }
248
249    #
250    # Lay out the widgets in a simple "Label: Value" scheme...
251    #
252    set row 0
253    foreach name $_controls {
254        set wl $_name2info($name-label)
255        if {$wl != "" && [winfo exists $wl]} {
256            grid $wl -row $row -column 0 -sticky e
257        }
258
259        set wv $_name2info($name-value)
260        if {$wv != "" && [winfo exists $wv]} {
261            grid $wv -row $row -column 1 -sticky ew
262
263            set frame [winfo parent $wv]
264            grid rowconfigure $frame $row -weight 0
265            grid rowconfigure $frame $row -weight 0
266
267            switch -- [winfo class $wv] {
268                TextEntry {
269                    if {[regexp {[0-9]+x[0-9]+} [$wv size]]} {
270                        grid $wl -sticky n -pady 4
271                        grid $wv -sticky nsew
272                        grid rowconfigure $frame $row -weight 1
273                        grid columnconfigure $frame 1 -weight 1
274                    }
275                }
276            }
277            grid columnconfigure $frame 1 -weight 1
278        }
279
280
281        incr row
282        grid rowconfigure [winfo parent $w] $row -minsize $itk_option(-padding)
283        incr row
284    }
285}
286
287# ----------------------------------------------------------------------
288# USAGE: _controlChanged <path>
289#
290# Invoked automatically whenever the value for the control with the
291# XML <path> changes.  Sends a notification along to the tool
292# controlling this panel.
293# ----------------------------------------------------------------------
294itcl::body Rappture::Controls::_controlChanged {path} {
295    if {"" != $_owner} {
296        $_owner changed $path
297    }
298}
299
300# ----------------------------------------------------------------------
301# USAGE: _formatLabel <string>
302#
303# Used internally to format a label <string>.  Trims any excess
304# white space and adds a ":" to the end.  That way, all labels
305# have a uniform look.
306# ----------------------------------------------------------------------
307itcl::body Rappture::Controls::_formatLabel {str} {
308    set str [string trim $str]
309    if {"" != $str && [string index $str end] != ":"} {
310        append str ":"
311    }
312    return $str
313}
314
315# ----------------------------------------------------------------------
316# OPTION: -padding
317# ----------------------------------------------------------------------
318itcl::configbody Rappture::Controls::padding {
319    $_dispatcher event -idle !layout
320}
Note: See TracBrowser for help on using the repository browser.