source: trunk/gui/scripts/switch.tcl @ 876

Last change on this file since 876 was 876, checked in by dkearney, 16 years ago

added ability to use upper or lowercase string boolean values
File size: 16.3 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: switch - on/off switch
3#
4#  This widget is used to control a (boolean) on/off value.  It shows
5#  a little light with the state of the switch, and offers a combobox
6#  to control the values.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2005  Purdue Research Foundation
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
15package require BLT
16
17option add *Switch.width 30 widgetDefault
18option add *Switch.height 20 widgetDefault
19option add *Switch.onColor red widgetDefault
20option add *Switch.offColor gray widgetDefault
21option add *Switch.valuePosition "right" widgetDefault
22option add *Switch.textBackground #cccccc widgetDefault
23
24itcl::class Rappture::Switch {
25    inherit itk::Widget
26
27    itk_option define -valueposition valuePosition ValuePosition ""
28    itk_option define -oncolor onColor Color ""
29    itk_option define -offcolor offColor Color ""
30    itk_option define -onimage onImage Image ""
31    itk_option define -offimage offImage Image ""
32    itk_option define -width width Width 0
33    itk_option define -height height Height 0
34    itk_option define -state state State "normal"
35
36    constructor {args} { # defined below }
37
38    public method value {args}
39
40    protected method _redraw {}
41    protected method _fixState {}
42    protected method _resize {}
43    protected method _hilite {comp state}
44    protected method _presets {option}
45    protected method _val2boolstr {args}
46
47    private variable _value "no"  ;# value for this widget
48
49    blt::bitmap define SwitchArrow {
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 Switch {
58    keep -cursor -font -foreground -background
59    keep -selectbackground -selectforeground -selectborderwidth
60}
61
62# ----------------------------------------------------------------------
63# CONSTRUCTOR
64#   the type is one of the following:
65#       "yes", "no",
66#       "true", "false",
67#       "on", "off",
68#       "1", "0",
69#   and determines what text is used as the dropdown options.
70#   if left empty or is a non-boolean value, type defaults to "no"
71# ----------------------------------------------------------------------
72itcl::body Rappture::Switch::constructor {type args} {
73    itk_component add icon {
74        canvas $itk_interior.icon -borderwidth 0 -highlightthickness 0
75    } {
76        usual
77        ignore -highlightthickness -highlightbackground -highlightcolor
78    }
79    pack $itk_component(icon) -side left
80    bind $itk_component(icon) <Configure> [itcl::code $this _redraw]
81
82    itk_component add -protected vframe {
83        frame $itk_interior.vframe
84    }
85
86    set valNumNeg 2
87    set valNumPos 3
88    set valTextNeg "no"
89    set valTextPos "yes"
90
91    if { ("" != $type) } {
92        set _value [string tolower $type]
93    }
94
95    if { ("on" == $_value) || ("off" == $_value) } {
96        set valNumNeg 4
97        set valNumPos 5
98        set valTextNeg "off"
99        set valTextPos "on"
100    } elseif { ("true" == $_value) || ("false" == $_value) } {
101        set valNumNeg 6
102        set valNumPos 7
103        set valTextNeg "false"
104        set valTextPos "true"
105    } elseif { ("1" == $_value) || ("0" == $_value) } {
106        # assigning values this way avoids a
107        # "string is integer -strict" problem in _val2boolstr
108        set valNumNeg 0
109        set valNumPos 1
110        set valTextNeg "0"
111        set valTextPos "1"
112    } else {
113        set _value "no"
114    }
115
116    itk_component add value {
117        label $itk_component(vframe).value -borderwidth 1 -width 7 \
118            -textvariable [itcl::scope _value]
119    } {
120        rename -background -textbackground textBackground Background
121    }
122    pack $itk_component(value) -side left -expand yes -fill both
123
124    itk_component add presets {
125        button $itk_component(vframe).psbtn -bitmap SwitchArrow \
126            -borderwidth 1 -highlightthickness 0 -relief flat
127    } {
128        usual
129        ignore -borderwidth -relief -highlightthickness
130        rename -background -textbackground textBackground Background
131    }
132
133    bind $itk_component(presets) <Enter> [itcl::code $this _hilite presets $valTextPos]
134    bind $itk_component(presets) <Leave> [itcl::code $this _hilite presets $valTextNeg]
135
136    itk_component add presetlist {
137        Rappture::Dropdownlist $itk_component(presets).plist \
138            -postcommand [itcl::code $this _presets post] \
139            -unpostcommand [itcl::code $this _presets unpost] \
140    }
141
142    $itk_component(presetlist) insert end $valNumPos $valTextPos $valNumNeg $valTextNeg
143
144    bind $itk_component(presetlist) <<DropdownlistSelect>> \
145        [itcl::code $this _presets select]
146
147    bind $itk_component(value) <ButtonPress> \
148        [itcl::code $this _presets dropdown]
149    $itk_component(presets) configure -command \
150        [itcl::code $this _presets dropdown]
151
152    eval itk_initialize $args
153}
154
155# ----------------------------------------------------------------------
156# USAGE: value ?-check? ?<newval>?
157#
158# Clients use this to query/set the value for this widget.  With
159# no args, it returns the current value for the widget.  If the
160# <newval> is specified, it sets the value of the widget and
161# sends a <<Value>> event.  If the -check flag is included, the
162# new value is not actually applied, but just checked for correctness.
163# ----------------------------------------------------------------------
164itcl::body Rappture::Switch::value {args} {
165    set onlycheck 0
166    set i [lsearch -exact $args -check]
167    if {$i >= 0} {
168        set onlycheck 1
169        set args [lreplace $args $i $i]
170    }
171
172    if {[llength $args] == 1} {
173
174        set newval [_val2boolstr [lindex $args 0]]
175        if {![string is boolean -strict $newval]} {
176            error "Should be a boolean value"
177        }
178
179        if {$onlycheck} {
180            return
181        }
182        set _value $newval
183        _fixState
184        event generate $itk_component(hull) <<Value>>
185
186    } elseif {[llength $args] != 0} {
187        error "wrong # args: should be \"value ?-check? ?newval?\""
188    }
189    return $_value
190}
191
192# ----------------------------------------------------------------------
193# USAGE: _val2boolstr <val>
194#
195# Clients use this to query/set the value for this widget.  With
196# no args, it returns the current value for the widget.  If the
197# <newval> is specified, it sets the value of the widget and
198# sends a <<Value>> event.  If the -check flag is included, the
199# new value is not actually applied, but just checked for correctness.
200# ----------------------------------------------------------------------
201itcl::body Rappture::Switch::_val2boolstr {args} {
202    set newval ""
203    if {[llength $args] == 1} {
204        set val [lindex $args 0]
205
206        if {![string is integer -strict $val]} {
207            return $val
208        }
209
210        if { (2 == $val) || (3 == $val) } {
211            set newval [expr {($val%2) ? "yes" : "no"}]
212        } elseif { (4 == $val) || (5 == $val) } {
213            set newval [expr {($val%2) ? "on" : "off"}]
214        } elseif { (6 == $val) || (7 == $val) } {
215            set newval [expr {($val%2) ? "true" : "false"}]
216        } elseif { (0 == $val) || (1 == $val) } {
217            set newval [expr {($val%2) ? "1" : "0"}]
218        }
219
220    } elseif {[llength $args] != 0} {
221        error "wrong # args: should be \"_val2boolstr val\""
222    }
223
224    return $newval
225}
226
227# ----------------------------------------------------------------------
228# USAGE: _redraw
229#
230# Used internally to redraw the gauge on the internal canvas based
231# on the current value and the size of the widget.  In this simple
232# base class, the gauge is drawn as a colored block, with an optional
233# image in the middle of it.
234# ----------------------------------------------------------------------
235itcl::body Rappture::Switch::_redraw {} {
236    set c $itk_component(icon)
237    set w [winfo width $c]
238    set h [winfo height $c]
239    set s [expr {($w < $h) ? $w : $h}]
240    set r [expr {0.5*$s-3}]
241    set wm [expr {0.5*$w}]
242    set hm [expr {0.5*$h}]
243
244    $c delete all
245
246    if {$itk_option(-onimage) == "" && $itk_option(-offimage) == ""} {
247        $c create oval [expr {$wm-$r+2}] [expr {$hm-$r+2}] \
248            [expr {$wm+$r+1}] [expr {$hm+$r+1}] -fill gray -outline ""
249        $c create oval [expr {$wm-$r}] [expr {$hm-$r}] \
250            [expr {$wm+$r+1}] [expr {$hm+$r+1}] -fill gray -outline ""
251        $c create oval [expr {$wm-$r}] [expr {$hm-$r}] \
252            [expr {$wm+$r}] [expr {$hm+$r}] -fill "" -outline black \
253            -tags main
254
255        $c create arc [expr {$wm-$r+2}] [expr {$hm-$r+2}] \
256            [expr {$wm+$r-2}] [expr {$hm+$r-2}] -fill "" -outline "" \
257            -start 90 -extent -60 -style arc -tags hilite
258
259        $c create arc [expr {$wm-$r+2}] [expr {$hm-$r+2}] \
260            [expr {$wm+$r-2}] [expr {$hm+$r-2}] -fill "" -outline "" \
261            -start -90 -extent -60 -style arc -tags lolite
262    } else {
263        $c create image [expr {0.5*$w}] [expr {0.5*$h}] \
264            -anchor center -image "" -tags bimage
265    }
266    _fixState
267}
268
269# ----------------------------------------------------------------------
270# USAGE: _fixState
271#
272# Used internally to fix the colors associated with the on/off
273# control.  This has an effect only if there is no -onimage or
274# -offimage.
275# ----------------------------------------------------------------------
276itcl::body Rappture::Switch::_fixState {} {
277    set c $itk_component(icon)
278
279    if {$_value} {
280        if {$itk_option(-onimage) != "" || $itk_option(-offimage) != ""} {
281            $c itemconfigure bimage -image $itk_option(-onimage)
282        } else {
283            set color $itk_option(-oncolor)
284            $c itemconfigure main -fill $color
285            $c itemconfigure hilite -outline \
286                [Rappture::color::brightness $color 1.0]
287            $c itemconfigure lolite -outline \
288                [Rappture::color::brightness $color -0.3]
289        }
290    } else {
291        if {$itk_option(-onimage) != "" || $itk_option(-offimage) != ""} {
292            $c itemconfigure bimage -image $itk_option(-offimage)
293        } else {
294            set color $itk_option(-offcolor)
295            $c itemconfigure main -fill $color
296            $c itemconfigure hilite -outline \
297                [Rappture::color::brightness $color 1.0]
298            $c itemconfigure lolite -outline \
299                [Rappture::color::brightness $color -0.3]
300        }
301    }
302}
303
304# ----------------------------------------------------------------------
305# USAGE: _resize
306#
307# Used internally to resize the internal canvas based on the -onimage
308# or -offimage options, or the size of the text.
309# ----------------------------------------------------------------------
310itcl::body Rappture::Switch::_resize {} {
311    if {$itk_option(-width) > 0} {
312        set w $itk_option(-width)
313    } else {
314        set w 0
315        foreach opt {-onimage -offimage} {
316            if {$itk_option($opt) != ""} {
317                set wi [expr {[image width $itk_option($opt)]+4}]
318                if {$wi > $w} { set w $wi }
319            }
320        }
321        if {$w <= 0} {
322            set w [winfo reqheight $itk_component(value)]
323        }
324    }
325
326    if {$itk_option(-height) > 0} {
327        set h $itk_option(-height)
328    } else {
329        set h 0
330        foreach opt {-onimage -offimage} {
331            if {$itk_option($opt) != ""} {
332                set hi [expr {[image height $itk_option($opt)]+4}]
333                if {$hi > $h} { set h $hi }
334            }
335        }
336        if {$h <= 0} {
337            set h [winfo reqheight $itk_component(value)]
338        }
339    }
340
341    $itk_component(icon) configure -width $w -height $h
342}
343
344# ----------------------------------------------------------------------
345# USAGE: _hilite <component> <state>
346#
347# Used internally to resize the internal canvas based on the -onimage
348# and -offimage options or the size of the text.
349# ----------------------------------------------------------------------
350itcl::body Rappture::Switch::_hilite {comp state} {
351    if {$itk_option(-state) == "disabled"} {
352        set state 0  ;# never hilite when disabled
353    }
354    if {$comp == "value"} {
355        if {$state} {
356            $itk_component(value) configure -relief solid
357        } else {
358            $itk_component(value) configure -relief flat
359        }
360        return
361    }
362    if {$state} {
363        $itk_component($comp) configure -relief solid
364    } else {
365        $itk_component($comp) configure -relief flat
366    }
367}
368
369# ----------------------------------------------------------------------
370# USAGE: _presets post
371# USAGE: _presets unpost
372# USAGE: _presets select
373#
374# Used internally to handle the list of presets for this gauge.  The
375# post/unpost options are invoked when the list is posted or unposted
376# to manage the relief of the controlling button.  The select option
377# is invoked whenever there is a selection from the list, to assign
378# the value back to the gauge.
379# ----------------------------------------------------------------------
380itcl::body Rappture::Switch::_presets {option} {
381    if {$itk_option(-state) != "normal"} {
382        return  ;# disabled? then bail out!
383    }
384    switch -- $option {
385        dropdown {
386            $itk_component(presetlist) post $itk_component(vframe) left
387        }
388        post {
389            set i [$itk_component(presetlist) index $_value]
390            if {$i >= 0} {
391                $itk_component(presetlist) select clear 0 end
392                $itk_component(presetlist) select set $i
393            }
394            after 10 [list $itk_component(presets) configure -relief sunken]
395        }
396        unpost {
397            $itk_component(presets) configure -relief flat
398        }
399        select {
400            set val [$itk_component(presetlist) current]
401            if {"" != $val} {
402                value $val
403            }
404        }
405        default {
406            error "bad option \"$option\": should be dropdown, post, unpost, select"
407        }
408    }
409}
410
411# ----------------------------------------------------------------------
412# CONFIGURATION OPTION: -onimage
413# ----------------------------------------------------------------------
414itcl::configbody Rappture::Switch::onimage {
415    if {$itk_option(-onimage) != ""
416          && [catch {image width $itk_option(-onimage)}]} {
417        error "bad value \"$itk_option(-onimage)\": should be Tk image"
418    }
419    _resize
420
421    if {$_value} {
422        # if the off state? then redraw to show this change
423        _redraw
424    }
425}
426
427# ----------------------------------------------------------------------
428# CONFIGURATION OPTION: -offimage
429# ----------------------------------------------------------------------
430itcl::configbody Rappture::Switch::offimage {
431    if {$itk_option(-offimage) != ""
432          && [catch {image width $itk_option(-offimage)}]} {
433        error "bad value \"$itk_option(-offimage)\": should be Tk image"
434    }
435    _resize
436
437    if {!$_value} {
438        # if the off state? then redraw to show this change
439        _redraw
440    }
441}
442
443# ----------------------------------------------------------------------
444# CONFIGURATION OPTION: -state
445# ----------------------------------------------------------------------
446itcl::configbody Rappture::Switch::state {
447    set valid {normal disabled}
448    if {[lsearch -exact $valid $itk_option(-state)] < 0} {
449        error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
450    }
451    $itk_component(value) configure -state $itk_option(-state)
452    $itk_component(presets) configure -state $itk_option(-state)
453}
454
455# ----------------------------------------------------------------------
456# CONFIGURATION OPTION: -valueposition
457# ----------------------------------------------------------------------
458itcl::configbody Rappture::Switch::valueposition {
459    array set side2anchor {
460        left   e
461        right  w
462        top    s
463        bottom n
464    }
465    set pos $itk_option(-valueposition)
466    if {![info exists side2anchor($pos)]} {
467        error "bad value \"$pos\": should be [join [lsort [array names side2anchor]] {, }]"
468    }
469    pack $itk_component(vframe) -before $itk_component(icon) \
470        -side $pos -expand yes -fill both -ipadx 2
471    $itk_component(value) configure -anchor $side2anchor($pos)
472
473    set s [expr {($pos == "left") ? "left" : "right"}]
474    pack $itk_component(presets) -before $itk_component(value) \
475        -side $s -fill y
476}
Note: See TracBrowser for help on using the repository browser.