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

Last change on this file since 3394 was 3330, checked in by gah, 11 years ago

merge (by hand) with Rappture1.2 branch

File size: 5.7 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: switch - on/off switch
4#
5#  This widget is used to control a (boolean) on/off value. 
6# It is just a wrapper around a button.
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::Switch {
17    inherit itk::Widget
18
19    itk_option define -oncolor onColor Color "#00cc00"
20    itk_option define -state state State "normal"
21    itk_option define -showimage showimage Showimage "true"
22    itk_option define -showtext showtext Showtext "true"
23    itk_option define -interactcommand interactCommand InteractCommand ""
24
25    constructor {args} { # defined below }
26    public method value {args}
27
28    private method _updateText {}
29    private method _toggle {args}
30    private variable _value 0  ;# value for this widget
31}
32
33itk::usual Switch {
34    keep -cursor -background
35}
36
37# ----------------------------------------------------------------------
38# CONSTRUCTOR
39# ----------------------------------------------------------------------
40itcl::body Rappture::Switch::constructor {args} {
41
42    itk_component add button {
43        button $itk_interior.value \
44            -compound left \
45            -overrelief flat -relief flat -padx 3 -pady 0 -bd 0 \
46            -command [itcl::code $this _toggle]
47    } {
48        #rename -background -textbackground textBackground Background
49    }
50    pack $itk_component(button) -side left -expand yes -fill both
51    eval itk_initialize $args
52}
53
54# ----------------------------------------------------------------------
55# USAGE: value ?-check? ?<newval>?
56#
57# Clients use this to query/set the value for this widget.  With
58# no args, it returns the current value for the widget.  If the
59# <newval> is specified, it sets the value of the widget and
60# sends a <<Value>> event.  If the -check flag is included, the
61# new value is not actually applied, but just checked for correctness.
62# ----------------------------------------------------------------------
63itcl::body Rappture::Switch::value {args} {
64    set onlycheck 0
65    set i [lsearch -exact $args -check]
66    if {$i >= 0} {
67        set onlycheck 1
68        set args [lreplace $args $i $i]
69    }
70    if {[llength $args] == 1} {
71        set newval [lindex $args 0]
72        if {![string is boolean -strict $newval]} {
73            error "Should be a boolean value"
74        }
75        set newval [expr {($newval) ? 1 : 0}]
76        if {$onlycheck} {
77            return
78        }
79        set _value $newval
80        event generate $itk_component(hull) <<Value>>
81        _updateText
82    } elseif {[llength $args] != 0} {
83        error "wrong # args: should be \"value ?-check? ?newval?\""
84    }
85    return [expr {($_value) ? "yes" : "no"}]
86}
87
88# ----------------------------------------------------------------------
89# _toggle
90#
91#        Use internally to convert the toggled button into the
92#        proper boolean format.  Yes, right now it's hardcoded to
93#        yes/no.  But in the future it could be some other text.
94#
95#        Can't use old "value" method because _value is already set
96#        be the widget and doesn't pass the value on the command line.
97#
98# ----------------------------------------------------------------------
99itcl::body Rappture::Switch::_toggle {} {
100    if {$_value} {
101        value off
102    } else {
103        value on
104    }
105    if {[string length $itk_option(-interactcommand)] > 0} {
106        uplevel #0 $itk_option(-interactcommand)
107    }
108}
109
110itcl::body Rappture::Switch::_updateText {} {
111    set image ""
112    set text ""
113    if { $_value } {
114        if {$itk_option(-showimage)} {
115            set image [Rappture::icon cbon]
116        }
117        if {$itk_option(-showtext)} {
118            set text "yes"
119        }
120    } else {
121        if {$itk_option(-showimage)} {
122            set image [Rappture::icon cboff]
123        }
124        if {$itk_option(-showtext)} {
125            set text "no"
126        }
127    }
128    $itk_component(button) configure -text $text -image $image
129}
130
131
132# ----------------------------------------------------------------------
133# CONFIGURATION OPTION: -oncolor
134# ----------------------------------------------------------------------
135itcl::configbody Rappture::Switch::oncolor {
136    # does nothing now, but may come back soon
137}
138
139# ----------------------------------------------------------------------
140# CONFIGURATION OPTION: -state
141# ----------------------------------------------------------------------
142itcl::configbody Rappture::Switch::state {
143    set valid {normal disabled}
144    if {[lsearch -exact $valid $itk_option(-state)] < 0} {
145        error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
146    }
147    $itk_component(button) configure -state $itk_option(-state)
148}
149
150# ----------------------------------------------------------------------
151# CONFIGURATION OPTION: -showimage
152# ----------------------------------------------------------------------
153itcl::configbody Rappture::Switch::showimage {
154    if {[string is boolean $itk_option(-showimage)] != 1} {
155        error "bad value \"$itk_option(-showimage)\": should be a boolean"
156    }
157    _updateText
158}
159
160# ----------------------------------------------------------------------
161# CONFIGURATION OPTION: -showtext
162# ----------------------------------------------------------------------
163itcl::configbody Rappture::Switch::showtext {
164    if {[string is boolean $itk_option(-showtext)] != 1} {
165        error "bad value \"$itk_option(-showtext)\": should be a boolean"
166    }
167    _updateText
168}
Note: See TracBrowser for help on using the repository browser.