source: trunk/gui/scripts/spinint.tcl @ 2035

Last change on this file since 2035 was 1929, checked in by gah, 14 years ago
File size: 5.5 KB
Line 
1
2# ----------------------------------------------------------------------
3#  COMPONENT: spinint - spinner for integer values
4#
5#  This widget is a spinner with up/down arrows for managing integer
6#  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 *Spinint.width 5 widgetDefault
18option add *Spinint.textBackground white widgetDefault
19
20blt::bitmap define Spinint-up {
21#define up_width 8
22#define up_height 4
23static unsigned char up_bits[] = {
24   0x10, 0x38, 0x7c, 0xfe};
25}
26
27blt::bitmap define Spinint-down {
28#define arrow_width 8
29#define arrow_height 4
30static unsigned char arrow_bits[] = {
31   0xfe, 0x7c, 0x38, 0x10};
32}
33
34itcl::class Rappture::Spinint {
35    inherit itk::Widget
36
37    itk_option define -min min Min ""
38    itk_option define -max max Max ""
39    itk_option define -delta delta Delta 1
40
41    constructor {args} { # defined below }
42
43    public method value {args}
44    public method bump {{delta up}}
45    protected method _validate {char}
46}
47
48itk::usual Spinint {
49    keep -cursor -font
50    keep -foreground -background
51    keep -textforeground -textbackground
52    keep -selectbackground -selectforeground -selectborderwidth
53}
54
55# ----------------------------------------------------------------------
56# CONSTRUCTOR
57# ----------------------------------------------------------------------
58itcl::body Rappture::Spinint::constructor {args} {
59    itk_component add entry {
60        entry $itk_interior.entry
61    } {
62        usual
63        keep -width
64        rename -background -textbackground textBackground Background
65        rename -foreground -textforeground textForeground Foreground
66        rename -highlightbackground -background background Background
67    }
68    pack $itk_component(entry) -side left -expand yes -fill x
69
70    bind $itk_component(entry) <KeyPress> \
71        [itcl::code $this _validate %A]
72    bind $itk_component(entry) <KeyPress-Return> \
73        "$this value \[$itk_component(entry) get\]"
74
75    itk_component add controls {
76        frame $itk_interior.cntls
77    }
78    pack $itk_component(controls) -side right
79
80    itk_component add up {
81        button $itk_component(controls).spinup -bitmap Spinint-up \
82            -borderwidth 1 -relief raised -highlightthickness 0 \
83            -command [itcl::code $this bump up]
84    } {
85        usual
86        ignore -borderwidth -highlightthickness
87    }
88    pack $itk_component(up) -side top -expand yes -fill both
89
90    itk_component add down {
91        button $itk_component(controls).spindn -bitmap Spinint-down \
92            -borderwidth 1 -relief raised -highlightthickness 0 \
93            -command [itcl::code $this bump down]
94    } {
95        usual
96        ignore -borderwidth -highlightthickness
97    }
98    pack $itk_component(down) -side bottom -expand yes -fill both
99
100    eval itk_initialize $args
101}
102
103# ----------------------------------------------------------------------
104# USAGE: value ?<newval>?
105#
106# Clients use this to query/set the value for this widget.  With
107# no args, it returns the current value for the widget.  If the
108# <newval> is specified, it sets the value of the widget and
109# sends a <<Value>> event.
110# ----------------------------------------------------------------------
111itcl::body Rappture::Spinint::value {args} {
112    if {[llength $args] == 1} {
113        set newval [lindex $args 0]
114
115        if {"" != $newval} {
116            if {"" != $itk_option(-min) && $newval < $itk_option(-min)} {
117                set newval $itk_option(-min)
118            }
119            if {"" != $itk_option(-max) && $newval > $itk_option(-max)} {
120                set newval $itk_option(-max)
121            }
122        }
123
124        $itk_component(entry) delete 0 end
125        $itk_component(entry) insert 0 $newval
126        after 10 [list catch [list event generate $itk_component(hull) <<Value>>]]
127    } elseif {[llength $args] != 0} {
128        error "wrong # args: should be \"value ?newval?\""
129    }
130    return [$itk_component(entry) get]
131}
132
133# ----------------------------------------------------------------------
134# USAGE: bump ?<delta>?
135#
136# Used internally when you click on the up/down arrows.  Clients
137# can also use it directly to bump values up/down.  The optional
138# <delta> can be an integer value or the keyword "up" or "down".
139# ----------------------------------------------------------------------
140itcl::body Rappture::Spinint::bump {{delta up}} {
141    if {"up" == $delta} {
142        set delta $itk_option(-delta)
143    } elseif {"down" == $delta} {
144        set delta [expr {-$itk_option(-delta)}]
145    } elseif {![string is integer $delta]} {
146        error "bad delta \"$delta\": should be up, down, or integer"
147    }
148
149    set val [$itk_component(entry) get]
150    if {$val == ""} {
151        set val 0
152    }
153    value [expr {$val+$delta}]
154}
155
156# ----------------------------------------------------------------------
157# USAGE: _validate <char>
158#
159# Validates each character as it is typed into the spinner.
160# If the <char> is not a digit, then this procedure beeps and
161# prevents the character from being inserted.
162# ----------------------------------------------------------------------
163itcl::body Rappture::Spinint::_validate {char} {
164    if {[string match "\[ -~\]" $char]} {
165        if {![string match "\[0-9\]" $char]} {
166            bell
167            return -code break
168        }
169    }
170}
Note: See TracBrowser for help on using the repository browser.