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

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

initial import

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