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

Last change on this file since 11 was 11, checked in by mmc, 19 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: 15.8 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: gauge - compact readout for real values
3#
4#  This widget is a readout for a real value.  It has a little glyph
5#  filled with color according to the value, followed by a numeric
6#  representation of the value itself.  The value can be edited, and
7#  a list of predefined values can be associated with a menu that
8#  drops down from the value.
9# ======================================================================
10#  AUTHOR:  Michael McLennan, Purdue University
11#  Copyright (c) 2004-2005
12#  Purdue Research Foundation, West Lafayette, IN
13# ======================================================================
14package require Itk
15package require BLT
16
17option add *Gauge.width 30 widgetDefault
18option add *Gauge.height 20 widgetDefault
19option add *Gauge.valuePosition "right" widgetDefault
20option add *Gauge.textBackground #cccccc widgetDefault
21option add *Gauge.editable yes widgetDefault
22
23itcl::class Rappture::Gauge {
24    inherit itk::Widget
25
26    itk_option define -editable editable Editable ""
27    itk_option define -spectrum spectrum Spectrum ""
28    itk_option define -units units Units ""
29    itk_option define -minvalue minValue MinValue ""
30    itk_option define -maxvalue maxValue MaxValue ""
31    itk_option define -presets presets Presets ""
32    itk_option define -valueposition valuePosition ValuePosition ""
33    itk_option define -image image Image ""
34    itk_option define -width width Width 0
35    itk_option define -height height Height 0
36
37    constructor {args} { # defined below }
38
39    public method value {args}
40
41    protected method _redraw {}
42    protected method _resize {}
43    protected method _hilite {comp state}
44    protected method _editor {option args}
45    protected method _presets {option}
46
47    private variable _value 0  ;# value for this widget
48
49    blt::bitmap define GaugeArrow {
50        #define arrow_width 9
51        #define arrow_height 4
52        static unsigned char arrow_bits[] = {
53           0x7f, 0x00, 0x3e, 0x00, 0x1c, 0x00, 0x08, 0x00};
54    }
55}
56                                                                               
57itk::usual Gauge {
58    keep -cursor -font -foreground -background
59    keep -selectbackground -selectforeground -selectborderwidth
60}
61
62# ----------------------------------------------------------------------
63# CONSTRUCTOR
64# ----------------------------------------------------------------------
65itcl::body Rappture::Gauge::constructor {args} {
66    itk_component add icon {
67        canvas $itk_interior.icon -borderwidth 0 -highlightthickness 0
68    } {
69        usual
70        ignore -highlightthickness -highlightbackground -highlightcolor
71    }
72    pack $itk_component(icon) -side left
73    bind $itk_component(icon) <Configure> [itcl::code $this _redraw]
74
75    itk_component add -protected vframe {
76        frame $itk_interior.vframe
77    }
78
79    itk_component add value {
80        label $itk_component(vframe).value -borderwidth 1 -width 7 \
81            -textvariable [itcl::scope _value]
82    } {
83        rename -background -textbackground textBackground Background
84    }
85    pack $itk_component(value) -side left -expand yes -fill both
86
87    bind $itk_component(value) <Enter> [itcl::code $this _hilite value on]
88    bind $itk_component(value) <Leave> [itcl::code $this _hilite value off]
89
90    itk_component add editor {
91        Rappture::Editor $itk_interior.editor \
92            -activatecommand [itcl::code $this _editor activate] \
93            -validatecommand [itcl::code $this _editor validate] \
94            -applycommand [itcl::code $this _editor apply]
95    }
96    bind $itk_component(value) <ButtonPress> \
97        [itcl::code $this _editor popup]
98
99    itk_component add presets {
100        button $itk_component(vframe).psbtn -bitmap GaugeArrow \
101            -borderwidth 1 -highlightthickness 0 -relief flat
102    } {
103        usual
104        ignore -borderwidth -relief -highlightthickness
105        rename -background -textbackground textBackground Background
106    }
107
108    bind $itk_component(presets) <Enter> [itcl::code $this _hilite presets on]
109    bind $itk_component(presets) <Leave> [itcl::code $this _hilite presets off]
110
111    itk_component add presetlist {
112        Rappture::Dropdownlist $itk_component(presets).plist \
113            -postcommand [itcl::code $this _presets post] \
114            -unpostcommand [itcl::code $this _presets unpost] \
115    }
116
117    bind $itk_component(presetlist) <<DropdownlistSelect>> \
118        [itcl::code $this _presets select]
119
120    $itk_component(presets) configure -command \
121        [list $itk_component(presetlist) post $itk_component(vframe) left]
122
123    eval itk_initialize $args
124}
125
126# ----------------------------------------------------------------------
127# USAGE: value ?-check? ?<newval>?
128#
129# Clients use this to query/set the value for this widget.  With
130# no args, it returns the current value for the widget.  If the
131# <newval> is specified, it sets the value of the widget and
132# sends a <<Value>> event.  If the -check flag is included, the
133# new value is not actually applied, but just checked for correctness.
134# ----------------------------------------------------------------------
135itcl::body Rappture::Gauge::value {args} {
136    set onlycheck 0
137    set i [lsearch -exact $args -check]
138    if {$i >= 0} {
139        set onlycheck 1
140        set args [lreplace $args $i $i]
141    }
142
143    if {[llength $args] == 1} {
144        #
145        # If this gauge has -units, try to convert the incoming
146        # value to that system of units.  Also, make sure that
147        # the value is bound by any min/max value constraints.
148        #
149        set newval [set nv [lindex $args 0]]
150        set units $itk_option(-units)
151        if {$units != ""} {
152            set newval [Rappture::Units::convert $newval \
153                -context $units]
154            set nv [Rappture::Units::convert $nv \
155                -context $units -to $units -units off]
156        }
157
158        if {"" != $itk_option(-minvalue)} {
159            set minv $itk_option(-minvalue)
160            if {$units != ""} {
161                set minv [Rappture::Units::convert $minv \
162                    -context $units -to $units -units off]
163            }
164            if {$nv < $minv} {
165                error "minimum value allowed here is $itk_option(-minvalue)"
166            }
167        }
168
169        if {"" != $itk_option(-maxvalue)} {
170            set maxv $itk_option(-maxvalue)
171            if {$units != ""} {
172                set maxv [Rappture::Units::convert $maxv \
173                    -context $units -to $units -units off]
174            }
175            if {$nv > $maxv} {
176                error "maximum value allowed here is $itk_option(-maxvalue)"
177            }
178        }
179
180        if {![string is double -strict $nv]} {
181            error "Should be a real number"
182        }
183
184        if {$onlycheck} {
185            return
186        }
187        set _value $newval
188        _redraw
189        event generate $itk_component(hull) <<Value>>
190
191    } elseif {[llength $args] != 0} {
192        error "wrong # args: should be \"value ?-check? ?newval?\""
193    }
194    return $_value
195}
196
197# ----------------------------------------------------------------------
198# USAGE: _redraw
199#
200# Used internally to redraw the gauge on the internal canvas based
201# on the current value and the size of the widget.  In this simple
202# base class, the gauge is drawn as a colored block, with an optional
203# image in the middle of it.
204# ----------------------------------------------------------------------
205itcl::body Rappture::Gauge::_redraw {} {
206    set c $itk_component(icon)
207    set w [winfo width $c]
208    set h [winfo height $c]
209
210    if {"" == [$c find all]} {
211        # first time around, create the items
212        $c create rectangle 0 0 1 1 -outline black -tags block
213        $c create image 0 0 -anchor center -image "" -tags bimage
214    }
215
216    if {"" != $itk_option(-spectrum)} {
217        set color [$itk_option(-spectrum) get $_value]
218    } else {
219        set color ""
220    }
221
222    # update the items based on current values
223    $c coords block 0 0 [expr {$w-1}] [expr {$h-1}]
224    $c itemconfigure block -fill $color
225
226    $c coords bimage [expr {0.5*$w}] [expr {0.5*$h}]
227}
228
229# ----------------------------------------------------------------------
230# USAGE: _resize
231#
232# Used internally to resize the internal canvas based on the -image
233# option or the size of the text.
234# ----------------------------------------------------------------------
235itcl::body Rappture::Gauge::_resize {} {
236    if {$itk_option(-width) > 0} {
237        set w $itk_option(-width)
238    } else {
239        if {$itk_option(-image) != ""} {
240            set w [expr {[image width $itk_option(-image)]+4}]
241        } else {
242            set w [winfo reqheight $itk_component(value)]
243        }
244    }
245
246    if {$itk_option(-height) > 0} {
247        set h $itk_option(-height)
248    } else {
249        if {$itk_option(-image) != ""} {
250            set h [expr {[image height $itk_option(-image)]+4}]
251        } else {
252            set h [winfo reqheight $itk_component(value)]
253        }
254    }
255
256    $itk_component(icon) configure -width $w -height $h
257}
258
259# ----------------------------------------------------------------------
260# USAGE: _hilite <component> <state>
261#
262# Used internally to resize the internal canvas based on the -image
263# option or the size of the text.
264# ----------------------------------------------------------------------
265itcl::body Rappture::Gauge::_hilite {comp state} {
266    if {$comp == "value" && !$itk_option(-editable)} {
267        $itk_component(value) configure -relief flat
268        return
269    }
270
271    if {$state} {
272        $itk_component($comp) configure -relief solid
273    } else {
274        $itk_component($comp) configure -relief flat
275    }
276}
277
278# ----------------------------------------------------------------------
279# USAGE: _editor popup
280# USAGE: _editor activate
281# USAGE: _editor validate <value>
282# USAGE: _editor apply <value>
283#
284# Used internally to handle the various functions of the pop-up
285# editor for the value of this gauge.
286# ----------------------------------------------------------------------
287itcl::body Rappture::Gauge::_editor {option args} {
288    switch -- $option {
289        popup {
290            if {$itk_option(-editable)} {
291                $itk_component(editor) activate
292            }
293        }
294        activate {
295            return [list text $_value \
296                x [winfo rootx $itk_component(value)] \
297                y [winfo rooty $itk_component(value)] \
298                w [winfo width $itk_component(value)] \
299                h [winfo height $itk_component(value)]]
300        }
301        validate {
302            if {[llength $args] != 1} {
303                error "wrong # args: should be \"_editor validate val\""
304            }
305            set val [lindex $args 0]
306
307            if {[catch {value -check $val} result]} {
308                if {[regexp {allowed here is (.+)} $result match newval]} {
309                    $itk_component(editor) value $newval
310                }
311                if {[regexp {^bad.*: +(.)(.+)} $result match first tail]
312                      || [regexp {(.)(.+)} $result match first tail]} {
313                    set result "[string toupper $first]$tail"
314                }
315                bell
316                Rappture::Tooltip::cue $itk_component(editor) $result
317                return 0
318            }
319        }
320        apply {
321            if {[llength $args] != 1} {
322                error "wrong # args: should be \"_editor apply val\""
323            }
324            value [lindex $args 0]
325        }
326        default {
327            error "bad option \"$option\": should be popup, activate, validate, apply"
328        }
329    }
330}
331
332# ----------------------------------------------------------------------
333# USAGE: _presets post
334# USAGE: _presets unpost
335# USAGE: _presets select
336#
337# Used internally to handle the list of presets for this gauge.  The
338# post/unpost options are invoked when the list is posted or unposted
339# to manage the relief of the controlling button.  The select option
340# is invoked whenever there is a selection from the list, to assign
341# the value back to the gauge.
342# ----------------------------------------------------------------------
343itcl::body Rappture::Gauge::_presets {option} {
344    switch -- $option {
345        post {
346            set i [$itk_component(presetlist) index $_value]
347            if {$i >= 0} {
348                $itk_component(presetlist) select clear 0 end
349                $itk_component(presetlist) select set $i
350            }
351            after 10 [list $itk_component(presets) configure -relief sunken]
352        }
353        unpost {
354            $itk_component(presets) configure -relief flat
355        }
356        select {
357            set val [$itk_component(presetlist) current]
358            if {"" != $val} {
359                value $val
360            }
361        }
362        default {
363            error "bad option \"$option\": should be post, unpost, select"
364        }
365    }
366}
367
368# ----------------------------------------------------------------------
369# CONFIGURATION OPTION: -editable
370# ----------------------------------------------------------------------
371itcl::configbody Rappture::Gauge::editable {
372    if {![string is boolean -strict $itk_option(-editable)]} {
373        error "bad value \"$itk_option(-editable)\": should be boolean"
374    }
375    if {!$itk_option(-editable) && [winfo ismapped $itk_component(editor)]} {
376        $itk_component(editor) deactivate -abort
377    }
378}
379
380# ----------------------------------------------------------------------
381# CONFIGURATION OPTION: -spectrum
382# ----------------------------------------------------------------------
383itcl::configbody Rappture::Gauge::spectrum {
384    if {$itk_option(-spectrum) != ""
385          && ([catch {$itk_option(-spectrum) isa ::Rappture::Spectrum} valid]
386               || !$valid)} {
387        error "bad option \"$itk_option(-spectrum)\": should be Rappture::Spectrum object"
388    }
389    _redraw
390}
391
392# ----------------------------------------------------------------------
393# CONFIGURATION OPTION: -image
394# ----------------------------------------------------------------------
395itcl::configbody Rappture::Gauge::image {
396    if {$itk_option(-image) != ""
397          && [catch {image width $itk_option(-image)}]} {
398        error "bad value \"$itk_option(-image)\": should be Tk image"
399    }
400    _resize
401    $itk_component(icon) itemconfigure bimage -image $itk_option(-image)
402}
403
404# ----------------------------------------------------------------------
405# CONFIGURATION OPTION: -units
406# ----------------------------------------------------------------------
407itcl::configbody Rappture::Gauge::units {
408    if {$itk_option(-units) != ""
409          && [::Rappture::Units::System::for $itk_option(-units)] == ""} {
410        error "unrecognized system of units \"$itk_option(-units)\""
411    }
412}
413
414# ----------------------------------------------------------------------
415# CONFIGURATION OPTION: -valueposition
416# ----------------------------------------------------------------------
417itcl::configbody Rappture::Gauge::valueposition {
418    array set side2anchor {
419        left   e
420        right  w
421        top    s
422        bottom n
423    }
424    set pos $itk_option(-valueposition)
425    if {![info exists side2anchor($pos)]} {
426        error "bad value \"$pos\": should be [join [lsort [array names side2anchor]] {, }]"
427    }
428    pack $itk_component(vframe) -before $itk_component(icon) \
429        -side $pos -expand yes -fill both -ipadx 2
430    $itk_component(value) configure -anchor $side2anchor($pos)
431}
432
433# ----------------------------------------------------------------------
434# CONFIGURATION OPTION: -presets
435# ----------------------------------------------------------------------
436itcl::configbody Rappture::Gauge::presets {
437    if {"" == $itk_option(-presets)} {
438        pack forget $itk_component(presets)
439    } else {
440        if {$itk_option(-valueposition) == "left"} {
441            set s "left"
442        } else {
443            set s "right"
444        }
445        pack $itk_component(presets) -before $itk_component(value) \
446            -side $s -fill y
447
448        $itk_component(presetlist) delete 0 end
449        $itk_component(presetlist) insert end $itk_option(-presets)
450    }
451}
Note: See TracBrowser for help on using the repository browser.