[5679] | 1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
---|
[1491] | 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 |
---|
[3177] | 9 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
[1491] | 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 | # ====================================================================== |
---|
| 14 | package require Itk |
---|
| 15 | package require BLT |
---|
| 16 | |
---|
| 17 | option add *Flowspeed.width 5 widgetDefault |
---|
| 18 | option add *Flowspeed.textBackground white widgetDefault |
---|
| 19 | |
---|
| 20 | blt::bitmap define Flowspeed-up { |
---|
| 21 | #define up_width 8 |
---|
| 22 | #define up_height 4 |
---|
| 23 | static unsigned char up_bits[] = { |
---|
| 24 | 0x10, 0x38, 0x7c, 0xfe}; |
---|
| 25 | } |
---|
| 26 | |
---|
| 27 | blt::bitmap define Flowspeed-down { |
---|
| 28 | #define arrow_width 8 |
---|
| 29 | #define arrow_height 4 |
---|
| 30 | static unsigned char arrow_bits[] = { |
---|
| 31 | 0xfe, 0x7c, 0x38, 0x10}; |
---|
| 32 | } |
---|
| 33 | |
---|
| 34 | itcl::class Rappture::Flowspeed { |
---|
| 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 | protected variable _value "" |
---|
| 47 | } |
---|
| 48 | |
---|
| 49 | itk::usual Flowspeed { |
---|
| 50 | keep -cursor -font |
---|
| 51 | keep -foreground -background |
---|
| 52 | keep -textforeground -textbackground |
---|
| 53 | keep -selectbackground -selectforeground -selectborderwidth |
---|
| 54 | } |
---|
| 55 | |
---|
| 56 | # ---------------------------------------------------------------------- |
---|
| 57 | # CONSTRUCTOR |
---|
| 58 | # ---------------------------------------------------------------------- |
---|
| 59 | itcl::body Rappture::Flowspeed::constructor {args} { |
---|
| 60 | itk_component add entry { |
---|
[1929] | 61 | entry $itk_interior.entry |
---|
[1491] | 62 | } { |
---|
[1929] | 63 | usual |
---|
| 64 | keep -width |
---|
| 65 | rename -background -textbackground textBackground Background |
---|
| 66 | rename -foreground -textforeground textForeground Foreground |
---|
| 67 | rename -highlightbackground -background background Background |
---|
[1491] | 68 | } |
---|
| 69 | pack $itk_component(entry) -side left -expand yes -fill x |
---|
| 70 | |
---|
| 71 | bind $itk_component(entry) <KeyPress> \ |
---|
[1929] | 72 | [itcl::code $this _validate %A] |
---|
[3454] | 73 | bind $itk_component(entry) <Return> \ |
---|
[1929] | 74 | "$this value \[$itk_component(entry) get\]" |
---|
[3454] | 75 | bind $itk_component(entry) <KP_Enter> \ |
---|
| 76 | "$this value \[$itk_component(entry) get\]" |
---|
[1511] | 77 | bind $itk_component(entry) <KeyPress-Tab> \ |
---|
[1929] | 78 | "$this value \[$itk_component(entry) get\]" |
---|
[1491] | 79 | |
---|
| 80 | itk_component add controls { |
---|
[1929] | 81 | frame $itk_interior.cntls |
---|
[1491] | 82 | } |
---|
| 83 | pack $itk_component(controls) -side right |
---|
| 84 | |
---|
| 85 | itk_component add up { |
---|
[1929] | 86 | button $itk_component(controls).spinup -bitmap Flowspeed-up \ |
---|
| 87 | -borderwidth 1 -relief raised -highlightthickness 0 \ |
---|
| 88 | -command [itcl::code $this bump up] |
---|
[1491] | 89 | } { |
---|
[1929] | 90 | usual |
---|
| 91 | ignore -borderwidth -highlightthickness |
---|
[1491] | 92 | } |
---|
| 93 | pack $itk_component(up) -side top -expand yes -fill both |
---|
| 94 | |
---|
| 95 | itk_component add down { |
---|
[1929] | 96 | button $itk_component(controls).spindn -bitmap Flowspeed-down \ |
---|
| 97 | -borderwidth 1 -relief raised -highlightthickness 0 \ |
---|
| 98 | -command [itcl::code $this bump down] |
---|
[1491] | 99 | } { |
---|
[1929] | 100 | usual |
---|
| 101 | ignore -borderwidth -highlightthickness |
---|
[1491] | 102 | } |
---|
| 103 | pack $itk_component(down) -side bottom -expand yes -fill both |
---|
| 104 | |
---|
| 105 | eval itk_initialize $args |
---|
| 106 | } |
---|
| 107 | |
---|
| 108 | # ---------------------------------------------------------------------- |
---|
| 109 | # USAGE: value ?<newval>? |
---|
| 110 | # |
---|
| 111 | # Clients use this to query/set the value for this widget. With |
---|
| 112 | # no args, it returns the current value for the widget. If the |
---|
| 113 | # <newval> is specified, it sets the value of the widget and |
---|
| 114 | # sends a <<Value>> event. |
---|
| 115 | # ---------------------------------------------------------------------- |
---|
| 116 | itcl::body Rappture::Flowspeed::value {args} { |
---|
| 117 | if {[llength $args] == 1} { |
---|
[1929] | 118 | set string [lindex $args 0] |
---|
| 119 | if { [regexp {^ *([0-9]+)x *$} $string match newval] } { |
---|
| 120 | } elseif { [regexp {^ *([0-9]+) *$} $string match newval] } { |
---|
| 121 | } else { |
---|
| 122 | bell |
---|
| 123 | return |
---|
| 124 | } |
---|
| 125 | if {"" != $newval} { |
---|
| 126 | if {"" != $itk_option(-min) && $newval < $itk_option(-min)} { |
---|
| 127 | set newval $itk_option(-min) |
---|
| 128 | } |
---|
| 129 | if {"" != $itk_option(-max) && $newval > $itk_option(-max)} { |
---|
| 130 | set newval $itk_option(-max) |
---|
| 131 | } |
---|
| 132 | } |
---|
| 133 | set _value $newval |
---|
| 134 | $itk_component(entry) delete 0 end |
---|
| 135 | $itk_component(entry) insert 0 ${newval}x |
---|
| 136 | after 10 \ |
---|
| 137 | [list catch [list event generate $itk_component(hull) <<Value>>]] |
---|
[1491] | 138 | } elseif {[llength $args] != 0} { |
---|
[1929] | 139 | error "wrong # args: should be \"value ?newval?\"" |
---|
[1491] | 140 | } |
---|
| 141 | return $_value |
---|
| 142 | } |
---|
| 143 | |
---|
| 144 | # ---------------------------------------------------------------------- |
---|
| 145 | # USAGE: bump ?<delta>? |
---|
| 146 | # |
---|
| 147 | # Used internally when you click on the up/down arrows. Clients |
---|
| 148 | # can also use it directly to bump values up/down. The optional |
---|
| 149 | # <delta> can be an integer value or the keyword "up" or "down". |
---|
| 150 | # ---------------------------------------------------------------------- |
---|
| 151 | itcl::body Rappture::Flowspeed::bump {{delta up}} { |
---|
| 152 | if {"up" == $delta} { |
---|
[1929] | 153 | set delta $itk_option(-delta) |
---|
[1491] | 154 | } elseif {"down" == $delta} { |
---|
[1929] | 155 | set delta [expr {-$itk_option(-delta)}] |
---|
[1491] | 156 | } elseif {![string is integer $delta]} { |
---|
[1929] | 157 | error "bad delta \"$delta\": should be up, down, or integer" |
---|
[1491] | 158 | } |
---|
| 159 | |
---|
| 160 | set val [$itk_component(entry) get] |
---|
| 161 | if {$val == ""} { |
---|
[1929] | 162 | set val 0 |
---|
[1491] | 163 | } |
---|
| 164 | value [expr {$_value+$delta}] |
---|
| 165 | } |
---|
| 166 | |
---|
| 167 | # ---------------------------------------------------------------------- |
---|
| 168 | # USAGE: _validate <char> |
---|
| 169 | # |
---|
| 170 | # Validates each character as it is typed into the spinner. |
---|
| 171 | # If the <char> is not a digit, then this procedure beeps and |
---|
| 172 | # prevents the character from being inserted. |
---|
| 173 | # ---------------------------------------------------------------------- |
---|
| 174 | itcl::body Rappture::Flowspeed::_validate {char} { |
---|
| 175 | if {[string match "\[ -~\]" $char]} { |
---|
[1929] | 176 | if {![string match "\[0-9\]" $char]} { |
---|
| 177 | bell |
---|
| 178 | return -code break |
---|
| 179 | } |
---|
[1491] | 180 | } |
---|
| 181 | } |
---|