source: branches/r9/gui/scripts/numberentry.tcl @ 5106

Last change on this file since 5106 was 3647, checked in by gah, 11 years ago

add string trim to inputs

File size: 7.8 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: NumberEntry - widget for entering numeric values
4#
5#  This widget represents a <number> entry on a control panel.
6#  It is used to enter numeric values.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
10#
11#  See the file "license.terms" for information on usage and
12#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13# ======================================================================
14package require Itk
15
16itcl::class Rappture::NumberEntry {
17    inherit itk::Widget
18
19    itk_option define -state state State "normal"
20
21    constructor {owner path args} { # defined below }
22
23    public method value {args}
24
25    public method label {}
26    public method tooltip {}
27
28    protected method _newValue {}
29
30    private variable _owner ""    ;# thing managing this control
31    private variable _path ""     ;# path in XML to this number
32}
33
34itk::usual NumberEntry {
35    keep -cursor -font
36    keep -foreground -background
37    keep -textbackground
38    keep -selectbackground -selectforeground -selectborderwidth
39}
40
41# ----------------------------------------------------------------------
42# CONSTRUCTOR
43# ----------------------------------------------------------------------
44itcl::body Rappture::NumberEntry::constructor {owner path args} {
45    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
46        error "bad object \"$owner\": should be Rappture::ControlOwner"
47    }
48    set _owner $owner
49    set _path $path
50   
51    #
52    # Figure out what sort of control to create
53    #
54    set presets ""
55    foreach pre [$_owner xml children -type preset $path] {
56        set value [string trim [$_owner xml get $path.$pre.value]]
57        set label [string trim [$_owner xml get $path.$pre.label]]
58        lappend presets $value $label
59    }
60   
61    set class Rappture::Gauge
62    set units [string trim [$_owner xml get $path.units]]
63    if {$units != ""} {
64        set desc [Rappture::Units::description $units]
65        if {[string match temperature* $desc]} {
66            set class Rappture::TemperatureGauge
67        }
68    }
69   
70    #
71    # Create the widget and configure it properly based on other
72    # hints in the XML.
73    #
74    itk_component add gauge {
75        $class $itk_interior.gauge -units $units -presets $presets -log $path
76    }
77    pack $itk_component(gauge) -expand yes -fill both
78    bind $itk_component(gauge) <<Value>> [itcl::code $this _newValue]
79   
80    set min [string trim [$_owner xml get $path.min]]
81    if {$min ne ""} {
82        $itk_component(gauge) configure -minvalue $min
83    }
84   
85    set max [string trim [$_owner xml get $path.max]]
86    if {$max ne ""} {
87        $itk_component(gauge) configure -maxvalue $max
88    }
89
90    if {$class == "Rappture::Gauge" && $min ne "" && $max ne ""} {
91        set color [string trim [$_owner xml get $path.about.color]]
92        if {$color == ""} {
93            # deprecated.  Color should be in "about"
94            set color [string trim [$_owner xml get $path.color]]
95        }
96        if {$color != ""}  {
97            if {$units != ""} {
98                set min [Rappture::Units::convert $min -to $units -units off]
99                set max [Rappture::Units::convert $max -to $units -units off]
100            }
101            # For compatibility. If only one color use white for min
102            if {[llength $color] == 1} {
103                set color [list $min white $max $color]
104            }
105            $itk_component(gauge) configure \
106                -spectrum [Rappture::Spectrum ::\#auto $color -units $units]
107        }
108    }
109
110    # if the control has an icon, plug it in
111    set str [string trim [$_owner xml get $path.about.icon]]
112    if {$str ne ""} {
113        $itk_component(gauge) configure -image [image create photo -data $str]
114    }
115    eval itk_initialize $args
116
117    #
118    # Assign the default value to this widget, if there is one.
119    #
120    set str [string trim [$_owner xml get $path.default]]
121    if {$str ne ""} {
122        $itk_component(gauge) value $str
123    }
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::NumberEntry::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        if {$onlycheck} {
145            # someday we may add validation...
146            return
147        }
148        set newval [string trim [lindex $args 0]]
149        $itk_component(gauge) value $newval
150        return $newval
151
152    } elseif {[llength $args] != 0} {
153        error "wrong # args: should be \"value ?-check? ?newval?\""
154    }
155
156    #
157    # Query the value and return.
158    #
159    return [$itk_component(gauge) value]
160}
161
162# ----------------------------------------------------------------------
163# USAGE: label
164#
165# Clients use this to query the label associated with this widget.
166# Reaches into the XML and pulls out the appropriate label string.
167# ----------------------------------------------------------------------
168itcl::body Rappture::NumberEntry::label {} {
169    set label [string trim [$_owner xml get $_path.about.label]]
170    if {"" == $label} {
171        set label "Number"
172    }
173    return $label
174}
175
176# ----------------------------------------------------------------------
177# USAGE: tooltip
178#
179# Clients use this to query the tooltip associated with this widget.
180# Reaches into the XML and pulls out the appropriate description
181# string.  Returns the string that should be used with the
182# Rappture::Tooltip facility.
183# ----------------------------------------------------------------------
184itcl::body Rappture::NumberEntry::tooltip {} {
185    set str   [string trim [$_owner xml get $_path.about.description]]
186
187    set units [string trim [$_owner xml get $_path.units]]
188    set min   [string trim [$_owner xml get $_path.min]]
189    set max   [string trim [$_owner xml get $_path.max]]
190
191    if {$units != "" || $min != "" || $max != ""} {
192        append str "\n\nEnter a number"
193
194        if {$min != "" && $max != ""} {
195            append str " between $min and $max"
196        } elseif {$min != ""} {
197            append str " greater than $min"
198        } elseif {$max != ""} {
199            append str " less than $max"
200        }
201
202        if {$units != ""} {
203            set desc [Rappture::Units::description $units]
204            append str " with units of $desc"
205        }
206    }
207    return [string trim $str]
208}
209
210# ----------------------------------------------------------------------
211# USAGE: _newValue
212#
213# Invoked automatically whenever the value in the gauge changes.
214# Sends a <<Value>> event to notify clients of the change.
215# ----------------------------------------------------------------------
216itcl::body Rappture::NumberEntry::_newValue {} {
217    event generate $itk_component(hull) <<Value>>
218}
219
220# ----------------------------------------------------------------------
221# CONFIGURATION OPTION: -state
222# ----------------------------------------------------------------------
223itcl::configbody Rappture::NumberEntry::state {
224    set valid {normal disabled}
225    if {[lsearch -exact $valid $itk_option(-state)] < 0} {
226        error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
227    }
228    $itk_component(gauge) configure -state $itk_option(-state)
229}
Note: See TracBrowser for help on using the repository browser.