| 1 | # ---------------------------------------------------------------------- |
|---|
| 2 | # COMPONENT: Radiodial - selector, like the dial on a car radio |
|---|
| 3 | # |
|---|
| 4 | # This widget looks like the dial on an old-fashioned car radio. |
|---|
| 5 | # It draws a series of values along an axis, and allows a selector |
|---|
| 6 | # to move back and forth to select 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 | # ====================================================================== |
|---|
| 14 | package require Itk |
|---|
| 15 | |
|---|
| 16 | option add *Radiodial.thickness 10 widgetDefault |
|---|
| 17 | option add *Radiodial.length 2i widgetDefault |
|---|
| 18 | option add *Radiodial.dialOutlineColor black widgetDefault |
|---|
| 19 | option add *Radiodial.dialFillColor white widgetDefault |
|---|
| 20 | option add *Radiodial.lineColor gray widgetDefault |
|---|
| 21 | option add *Radiodial.activeLineColor black widgetDefault |
|---|
| 22 | option add *Radiodial.valueWidth 10 widgetDefault |
|---|
| 23 | option add *Radiodial.font \ |
|---|
| 24 | -*-helvetica-medium-r-normal-*-*-120-* widgetDefault |
|---|
| 25 | |
|---|
| 26 | itcl::class Rappture::Radiodial { |
|---|
| 27 | inherit itk::Widget |
|---|
| 28 | |
|---|
| 29 | itk_option define -min min Min "" |
|---|
| 30 | itk_option define -max max Max "" |
|---|
| 31 | itk_option define -variable variable Variable "" |
|---|
| 32 | |
|---|
| 33 | itk_option define -thickness thickness Thickness 0 |
|---|
| 34 | itk_option define -length length Length 0 |
|---|
| 35 | |
|---|
| 36 | itk_option define -dialoutlinecolor dialOutlineColor Color "black" |
|---|
| 37 | itk_option define -dialfillcolor dialFillColor Color "white" |
|---|
| 38 | itk_option define -linecolor lineColor Color "black" |
|---|
| 39 | itk_option define -activelinecolor activeLineColor Color "black" |
|---|
| 40 | |
|---|
| 41 | itk_option define -font font Font "" |
|---|
| 42 | itk_option define -valuewidth valueWidth ValueWidth 0 |
|---|
| 43 | |
|---|
| 44 | |
|---|
| 45 | constructor {args} { # defined below } |
|---|
| 46 | destructor { # defined below } |
|---|
| 47 | |
|---|
| 48 | public method add {label {value ""}} |
|---|
| 49 | public method clear {} |
|---|
| 50 | public method get {args} |
|---|
| 51 | public method current {args} |
|---|
| 52 | public method color {value} |
|---|
| 53 | |
|---|
| 54 | protected method _setCurrent {val} |
|---|
| 55 | protected method _redraw {} |
|---|
| 56 | protected method _click {x y} |
|---|
| 57 | protected method _navigate {offset} |
|---|
| 58 | protected method _limits {} |
|---|
| 59 | protected method _fixSize {} |
|---|
| 60 | protected method _fixValue {args} |
|---|
| 61 | |
|---|
| 62 | private variable _values "" ;# list of all values on the dial |
|---|
| 63 | private variable _val2label ;# maps value => label |
|---|
| 64 | private variable _current "" ;# current value (where pointer is) |
|---|
| 65 | private variable _variable "" ;# variable associated with -variable |
|---|
| 66 | |
|---|
| 67 | private variable _spectrum "" ;# width allocated for values |
|---|
| 68 | private variable _activecolor "" ;# width allocated for values |
|---|
| 69 | private variable _vwidth 0 ;# width allocated for values |
|---|
| 70 | |
|---|
| 71 | # |
|---|
| 72 | # Load the image for the knob. |
|---|
| 73 | # |
|---|
| 74 | private common images |
|---|
| 75 | set images(knob) [image create photo -data { |
|---|
| 76 | R0lGODlhCQAMAMIEAAQCBJyanNza3Pz+/P///////////////yH5BAEKAAQALAAAAAAJAAwAAAMj |
|---|
| 77 | SEqwDqO9MYJkVASLh/gbAHmgNX6amZXimrbVFkKyLN44kAAAOw== |
|---|
| 78 | }] |
|---|
| 79 | } |
|---|
| 80 | |
|---|
| 81 | itk::usual Radiodial { |
|---|
| 82 | } |
|---|
| 83 | |
|---|
| 84 | # ---------------------------------------------------------------------- |
|---|
| 85 | # CONSTRUCTOR |
|---|
| 86 | # ---------------------------------------------------------------------- |
|---|
| 87 | itcl::body Rappture::Radiodial::constructor {args} { |
|---|
| 88 | itk_component add dial { |
|---|
| 89 | canvas $itk_interior.dial |
|---|
| 90 | } |
|---|
| 91 | pack $itk_component(dial) -expand yes -fill both |
|---|
| 92 | bind $itk_component(dial) <Configure> [itcl::code $this _redraw] |
|---|
| 93 | |
|---|
| 94 | bind $itk_component(dial) <ButtonPress-1> [itcl::code $this _click %x %y] |
|---|
| 95 | bind $itk_component(dial) <B1-Motion> [itcl::code $this _click %x %y] |
|---|
| 96 | bind $itk_component(dial) <ButtonRelease-1> [itcl::code $this _click %x %y] |
|---|
| 97 | |
|---|
| 98 | bind $itk_component(hull) <KeyPress-Left> [itcl::code $this _navigate -1] |
|---|
| 99 | bind $itk_component(hull) <KeyPress-Right> [itcl::code $this _navigate 1] |
|---|
| 100 | |
|---|
| 101 | eval itk_initialize $args |
|---|
| 102 | |
|---|
| 103 | _fixSize |
|---|
| 104 | } |
|---|
| 105 | |
|---|
| 106 | # ---------------------------------------------------------------------- |
|---|
| 107 | # DESTRUCTOR |
|---|
| 108 | # ---------------------------------------------------------------------- |
|---|
| 109 | itcl::body Rappture::Radiodial::destructor {} { |
|---|
| 110 | configure -variable "" ;# remove variable trace |
|---|
| 111 | after cancel [itcl::code $this _redraw] |
|---|
| 112 | } |
|---|
| 113 | |
|---|
| 114 | # ---------------------------------------------------------------------- |
|---|
| 115 | # USAGE: add <label> ?<value>? |
|---|
| 116 | # |
|---|
| 117 | # Clients use this to add new values to the dial. Values are always |
|---|
| 118 | # sorted in order along the dial. If the value is not specified, |
|---|
| 119 | # then it is created automatically based on the number of elements |
|---|
| 120 | # on the dial. |
|---|
| 121 | # ---------------------------------------------------------------------- |
|---|
| 122 | itcl::body Rappture::Radiodial::add {label {value ""}} { |
|---|
| 123 | if {"" == $value} { |
|---|
| 124 | set value [llength $_values] |
|---|
| 125 | } |
|---|
| 126 | lappend _values $value |
|---|
| 127 | set _values [lsort -real $_values] |
|---|
| 128 | set _val2label($value) $label |
|---|
| 129 | |
|---|
| 130 | if {"" == $_current} { |
|---|
| 131 | _setCurrent $value |
|---|
| 132 | } |
|---|
| 133 | |
|---|
| 134 | after cancel [itcl::code $this _redraw] |
|---|
| 135 | after idle [itcl::code $this _redraw] |
|---|
| 136 | } |
|---|
| 137 | |
|---|
| 138 | # ---------------------------------------------------------------------- |
|---|
| 139 | # USAGE: clear |
|---|
| 140 | # |
|---|
| 141 | # Clients use this to remove all existing values from the dial. |
|---|
| 142 | # ---------------------------------------------------------------------- |
|---|
| 143 | itcl::body Rappture::Radiodial::clear {} { |
|---|
| 144 | set _values "" |
|---|
| 145 | _setCurrent "" |
|---|
| 146 | catch {unset _val2label} |
|---|
| 147 | |
|---|
| 148 | after cancel [itcl::code $this _redraw] |
|---|
| 149 | after idle [itcl::code $this _redraw] |
|---|
| 150 | } |
|---|
| 151 | |
|---|
| 152 | # ---------------------------------------------------------------------- |
|---|
| 153 | # USAGE: get ?-format what? ?current|@index? |
|---|
| 154 | # |
|---|
| 155 | # Clients use this to query values within this radiodial. With no |
|---|
| 156 | # args, it returns a list of all values stored in the widget. The |
|---|
| 157 | # "current" arg requests only the current value on the radiodial. |
|---|
| 158 | # The @index syntax can be used to request a particular value at |
|---|
| 159 | # an index within the list of values. |
|---|
| 160 | # |
|---|
| 161 | # By default, this method returns the label for each value. The |
|---|
| 162 | # format option can be used to request the label, the value, or |
|---|
| 163 | # both. |
|---|
| 164 | # ---------------------------------------------------------------------- |
|---|
| 165 | itcl::body Rappture::Radiodial::get {args} { |
|---|
| 166 | Rappture::getopts args params { |
|---|
| 167 | value -format "label" |
|---|
| 168 | } |
|---|
| 169 | if {[llength $args] > 1} { |
|---|
| 170 | error "wrong # args: should be \"get ?-format f? ?current|@index\"" |
|---|
| 171 | } |
|---|
| 172 | set index [lindex $args 0] |
|---|
| 173 | if {"" == $index} { |
|---|
| 174 | set ilist "" |
|---|
| 175 | for {set i 0} {$i < [llength $_values]} {incr i} { |
|---|
| 176 | lappend ilist $i |
|---|
| 177 | } |
|---|
| 178 | } elseif {"current" == $index} { |
|---|
| 179 | set ilist [lsearch -exact $_values $_current] |
|---|
| 180 | if {$ilist < 0} { |
|---|
| 181 | set ilist "" |
|---|
| 182 | } |
|---|
| 183 | } elseif {[regexp {^@([0-9]+|end)$} $index match i]} { |
|---|
| 184 | set ilist $i |
|---|
| 185 | } |
|---|
| 186 | if {[llength $ilist] == 1} { |
|---|
| 187 | set op set |
|---|
| 188 | } else { |
|---|
| 189 | set op lappend |
|---|
| 190 | } |
|---|
| 191 | |
|---|
| 192 | set rlist "" |
|---|
| 193 | foreach i $ilist { |
|---|
| 194 | switch -- $params(-format) { |
|---|
| 195 | label { |
|---|
| 196 | set v [lindex $_values $i] |
|---|
| 197 | $op rlist $_val2label($v) |
|---|
| 198 | } |
|---|
| 199 | value { |
|---|
| 200 | $op rlist [lindex $_values $i] |
|---|
| 201 | } |
|---|
| 202 | position { |
|---|
| 203 | foreach {min max} [_limits] break |
|---|
| 204 | set v [lindex $_values $i] |
|---|
| 205 | set frac [expr {double($v-$min)/($max-$min)}] |
|---|
| 206 | $op rlist $frac |
|---|
| 207 | } |
|---|
| 208 | all { |
|---|
| 209 | set v [lindex $_values $i] |
|---|
| 210 | foreach {min max} [_limits] break |
|---|
| 211 | set frac [expr {double($v-$min)/($max-$min)}] |
|---|
| 212 | $op rlist [list $_val2label($v) $v $frac] |
|---|
| 213 | } |
|---|
| 214 | default { |
|---|
| 215 | error "bad value \"$v\": should be label, value, position, all" |
|---|
| 216 | } |
|---|
| 217 | } |
|---|
| 218 | } |
|---|
| 219 | return $rlist |
|---|
| 220 | } |
|---|
| 221 | |
|---|
| 222 | # ---------------------------------------------------------------------- |
|---|
| 223 | # USAGE: current ?<newval>? |
|---|
| 224 | # |
|---|
| 225 | # Clients use this to get/set the current value for this widget. |
|---|
| 226 | # ---------------------------------------------------------------------- |
|---|
| 227 | itcl::body Rappture::Radiodial::current {args} { |
|---|
| 228 | if {[llength $args] == 0} { |
|---|
| 229 | return $_current |
|---|
| 230 | } elseif {[llength $args] == 1} { |
|---|
| 231 | set newval [lindex $args 0] |
|---|
| 232 | set found 0 |
|---|
| 233 | foreach v $_values { |
|---|
| 234 | if {[string equal $_val2label($v) $newval]} { |
|---|
| 235 | set newval $v |
|---|
| 236 | set found 1 |
|---|
| 237 | break |
|---|
| 238 | } |
|---|
| 239 | } |
|---|
| 240 | if {!$found} { |
|---|
| 241 | error "bad value \"$newval\"" |
|---|
| 242 | } |
|---|
| 243 | _setCurrent $newval |
|---|
| 244 | |
|---|
| 245 | after cancel [itcl::code $this _redraw] |
|---|
| 246 | after idle [itcl::code $this _redraw] |
|---|
| 247 | event generate $itk_component(hull) <<Value>> |
|---|
| 248 | |
|---|
| 249 | return $_current |
|---|
| 250 | } |
|---|
| 251 | error "wrong # args: should be \"current ?newval?\"" |
|---|
| 252 | } |
|---|
| 253 | |
|---|
| 254 | # ---------------------------------------------------------------------- |
|---|
| 255 | # USAGE: color <value> |
|---|
| 256 | # |
|---|
| 257 | # Clients use this to query the color associated with a <value> |
|---|
| 258 | # along the dial. |
|---|
| 259 | # ---------------------------------------------------------------------- |
|---|
| 260 | itcl::body Rappture::Radiodial::color {value} { |
|---|
| 261 | set found 0 |
|---|
| 262 | foreach v $_values { |
|---|
| 263 | if {[string equal $_val2label($v) $value]} { |
|---|
| 264 | set value $v |
|---|
| 265 | set found 1 |
|---|
| 266 | break |
|---|
| 267 | } |
|---|
| 268 | } |
|---|
| 269 | if {!$found} { |
|---|
| 270 | error "bad value \"$value\"" |
|---|
| 271 | } |
|---|
| 272 | |
|---|
| 273 | if {"" != $_spectrum} { |
|---|
| 274 | foreach {min max} [_limits] break |
|---|
| 275 | set frac [expr {double($value-$min)/($max-$min)}] |
|---|
| 276 | set color [$_spectrum get $frac] |
|---|
| 277 | } else { |
|---|
| 278 | if {$value == $_current} { |
|---|
| 279 | set color $_activecolor |
|---|
| 280 | } else { |
|---|
| 281 | set color $itk_option(-linecolor) |
|---|
| 282 | } |
|---|
| 283 | } |
|---|
| 284 | return $color |
|---|
| 285 | } |
|---|
| 286 | |
|---|
| 287 | # ---------------------------------------------------------------------- |
|---|
| 288 | # USAGE: _setCurrent <value> |
|---|
| 289 | # |
|---|
| 290 | # Called automatically whenever the widget changes size to redraw |
|---|
| 291 | # all elements within it. |
|---|
| 292 | # ---------------------------------------------------------------------- |
|---|
| 293 | itcl::body Rappture::Radiodial::_setCurrent {value} { |
|---|
| 294 | set _current $value |
|---|
| 295 | if {"" != $_variable} { |
|---|
| 296 | upvar #0 $_variable var |
|---|
| 297 | if {[info exists _val2label($value)]} { |
|---|
| 298 | set var $_val2label($value) |
|---|
| 299 | } else { |
|---|
| 300 | set var $value |
|---|
| 301 | } |
|---|
| 302 | } |
|---|
| 303 | } |
|---|
| 304 | |
|---|
| 305 | # ---------------------------------------------------------------------- |
|---|
| 306 | # USAGE: _redraw |
|---|
| 307 | # |
|---|
| 308 | # Called automatically whenever the widget changes size to redraw |
|---|
| 309 | # all elements within it. |
|---|
| 310 | # ---------------------------------------------------------------------- |
|---|
| 311 | itcl::body Rappture::Radiodial::_redraw {} { |
|---|
| 312 | set c $itk_component(dial) |
|---|
| 313 | $c delete all |
|---|
| 314 | |
|---|
| 315 | set w [winfo width $c] |
|---|
| 316 | set h [winfo height $c] |
|---|
| 317 | set y1 [expr {$h-[image height $images(knob)]/2-1}] |
|---|
| 318 | set y0 [expr {$y1 - $itk_option(-thickness)-1}] |
|---|
| 319 | set x0 1 |
|---|
| 320 | set x1 [expr {$w-$_vwidth-4}] |
|---|
| 321 | |
|---|
| 322 | # draw the background rectangle |
|---|
| 323 | $c create rectangle $x0 $y0 $x1 $y1 \ |
|---|
| 324 | -outline $itk_option(-dialoutlinecolor) \ |
|---|
| 325 | -fill $itk_option(-dialfillcolor) |
|---|
| 326 | |
|---|
| 327 | # draw lines for all values |
|---|
| 328 | foreach {min max} [_limits] break |
|---|
| 329 | if {$max > $min} { |
|---|
| 330 | foreach v $_values { |
|---|
| 331 | set frac [expr {double($v-$min)/($max-$min)}] |
|---|
| 332 | if {"" != $_spectrum} { |
|---|
| 333 | set color [$_spectrum get $frac] |
|---|
| 334 | } else { |
|---|
| 335 | if {$v == $_current} { |
|---|
| 336 | set color $_activecolor |
|---|
| 337 | } else { |
|---|
| 338 | set color $itk_option(-linecolor) |
|---|
| 339 | } |
|---|
| 340 | } |
|---|
| 341 | set thick [expr {($v == $_current) ? 3 : 1}] |
|---|
| 342 | |
|---|
| 343 | set x [expr {$frac*($x1-$x0) + $x0}] |
|---|
| 344 | $c create line $x [expr {$y0+1}] $x $y1 -fill $color -width $thick |
|---|
| 345 | } |
|---|
| 346 | |
|---|
| 347 | if {"" != $_current} { |
|---|
| 348 | set x [expr {double($_current-$min)/($max-$min)*($x1-$x0) + $x0}] |
|---|
| 349 | $c create image $x [expr {$h-1}] -anchor s -image $images(knob) |
|---|
| 350 | } |
|---|
| 351 | } |
|---|
| 352 | |
|---|
| 353 | # if the -valuewidth is > 0, then make room for the value |
|---|
| 354 | set vw $itk_option(-valuewidth) |
|---|
| 355 | if {$vw > 0 && "" != $_current} { |
|---|
| 356 | set str $_val2label($_current) |
|---|
| 357 | if {[string length $str] >= $vw} { |
|---|
| 358 | set str "[string range $str 0 [expr {$vw-3}]]..." |
|---|
| 359 | } |
|---|
| 360 | |
|---|
| 361 | set dy [expr {([font metrics $itk_option(-font) -linespace] |
|---|
| 362 | - [font metrics $itk_option(-font) -ascent])/2}] |
|---|
| 363 | |
|---|
| 364 | set id [$c create text [expr {$x1+4}] [expr {($y1+$y0)/2+$dy}] \ |
|---|
| 365 | -anchor w -text $str -font $itk_option(-font)] |
|---|
| 366 | foreach {x0 y0 x1 y1} [$c bbox $id] break |
|---|
| 367 | set x0 [expr {$x0 + 10}] |
|---|
| 368 | |
|---|
| 369 | # set up a tooltip so you can mouse over truncated values |
|---|
| 370 | Rappture::Tooltip::text $c $_val2label($_current) |
|---|
| 371 | $c bind $id <Enter> \ |
|---|
| 372 | [list ::Rappture::Tooltip::tooltip pending %W +$x0,$y1] |
|---|
| 373 | $c bind $id <Leave> \ |
|---|
| 374 | [list ::Rappture::Tooltip::tooltip cancel] |
|---|
| 375 | $c bind $id <ButtonPress> \ |
|---|
| 376 | [list ::Rappture::Tooltip::tooltip cancel] |
|---|
| 377 | $c bind $id <KeyPress> \ |
|---|
| 378 | [list ::Rappture::Tooltip::tooltip cancel] |
|---|
| 379 | } |
|---|
| 380 | } |
|---|
| 381 | |
|---|
| 382 | # ---------------------------------------------------------------------- |
|---|
| 383 | # USAGE: _click <x> <y> |
|---|
| 384 | # |
|---|
| 385 | # Called automatically whenever the user clicks or drags on the widget |
|---|
| 386 | # to select a value. Moves the current value to the one nearest the |
|---|
| 387 | # click point. If the value actually changes, it generates a <<Value>> |
|---|
| 388 | # event to notify clients. |
|---|
| 389 | # ---------------------------------------------------------------------- |
|---|
| 390 | itcl::body Rappture::Radiodial::_click {x y} { |
|---|
| 391 | set c $itk_component(dial) |
|---|
| 392 | set w [winfo width $c] |
|---|
| 393 | set h [winfo height $c] |
|---|
| 394 | set x0 1 |
|---|
| 395 | set x1 [expr {$w-$_vwidth-4}] |
|---|
| 396 | |
|---|
| 397 | focus $itk_component(hull) |
|---|
| 398 | |
|---|
| 399 | # draw lines for all values |
|---|
| 400 | foreach {min max} [_limits] break |
|---|
| 401 | if {$max > $min && $x >= $x0 && $x <= $x1} { |
|---|
| 402 | set dmin $w |
|---|
| 403 | set xnearest 0 |
|---|
| 404 | set vnearest "" |
|---|
| 405 | foreach v $_values { |
|---|
| 406 | set xv [expr {double($v-$min)/($max-$min)*($x1-$x0) + $x0}] |
|---|
| 407 | if {abs($xv-$x) < $dmin} { |
|---|
| 408 | set dmin [expr {abs($xv-$x)}] |
|---|
| 409 | set xnearest $xv |
|---|
| 410 | set vnearest $v |
|---|
| 411 | } |
|---|
| 412 | } |
|---|
| 413 | |
|---|
| 414 | if {$vnearest != $_current} { |
|---|
| 415 | _setCurrent $vnearest |
|---|
| 416 | _redraw |
|---|
| 417 | |
|---|
| 418 | event generate $itk_component(hull) <<Value>> |
|---|
| 419 | } |
|---|
| 420 | } |
|---|
| 421 | } |
|---|
| 422 | |
|---|
| 423 | # ---------------------------------------------------------------------- |
|---|
| 424 | # USAGE: _navigate <offset> |
|---|
| 425 | # |
|---|
| 426 | # Called automatically whenever the user presses left/right keys |
|---|
| 427 | # to nudge the current value left or right by some <offset>. If the |
|---|
| 428 | # value actually changes, it generates a <<Value>> event to notify |
|---|
| 429 | # clients. |
|---|
| 430 | # ---------------------------------------------------------------------- |
|---|
| 431 | itcl::body Rappture::Radiodial::_navigate {offset} { |
|---|
| 432 | set index [lsearch -exact $_values $_current] |
|---|
| 433 | if {$index >= 0} { |
|---|
| 434 | incr index $offset |
|---|
| 435 | if {$index >= [llength $_values]} { |
|---|
| 436 | set index [expr {[llength $_values]-1}] |
|---|
| 437 | } elseif {$index < 0} { |
|---|
| 438 | set index 0 |
|---|
| 439 | } |
|---|
| 440 | |
|---|
| 441 | set newval [lindex $_values $index] |
|---|
| 442 | if {$newval != $_current} { |
|---|
| 443 | _setCurrent $newval |
|---|
| 444 | _redraw |
|---|
| 445 | |
|---|
| 446 | event generate $itk_component(hull) <<Value>> |
|---|
| 447 | } |
|---|
| 448 | } |
|---|
| 449 | } |
|---|
| 450 | |
|---|
| 451 | # ---------------------------------------------------------------------- |
|---|
| 452 | # USAGE: _limits |
|---|
| 453 | # |
|---|
| 454 | # Used internally to compute the overall min/max limits for the |
|---|
| 455 | # radio dial. Returns {min max}, representing the end values for |
|---|
| 456 | # the scale. |
|---|
| 457 | # ---------------------------------------------------------------------- |
|---|
| 458 | itcl::body Rappture::Radiodial::_limits {} { |
|---|
| 459 | if {[llength $_values] == 0} { |
|---|
| 460 | set min 0 |
|---|
| 461 | set max 0 |
|---|
| 462 | } else { |
|---|
| 463 | set min [lindex $_values 0] |
|---|
| 464 | set max $min |
|---|
| 465 | foreach v [lrange $_values 1 end] { |
|---|
| 466 | if {$v < $min} { set min $v } |
|---|
| 467 | if {$v > $max} { set max $v } |
|---|
| 468 | } |
|---|
| 469 | set del [expr {$max-$min}] |
|---|
| 470 | set min [expr {$min-0.1*$del}] |
|---|
| 471 | set max [expr {$max+0.1*$del}] |
|---|
| 472 | } |
|---|
| 473 | |
|---|
| 474 | if {"" != $itk_option(-min)} { |
|---|
| 475 | set min $itk_option(-min) |
|---|
| 476 | } |
|---|
| 477 | if {"" != $itk_option(-max)} { |
|---|
| 478 | set max $itk_option(-max) |
|---|
| 479 | } |
|---|
| 480 | return [list $min $max] |
|---|
| 481 | } |
|---|
| 482 | |
|---|
| 483 | # ---------------------------------------------------------------------- |
|---|
| 484 | # USAGE: _fixSize |
|---|
| 485 | # |
|---|
| 486 | # Used internally to compute the overall size of the widget based |
|---|
| 487 | # on the -thickness and -length options. |
|---|
| 488 | # ---------------------------------------------------------------------- |
|---|
| 489 | itcl::body Rappture::Radiodial::_fixSize {} { |
|---|
| 490 | set h [winfo pixels $itk_component(hull) $itk_option(-thickness)] |
|---|
| 491 | set h [expr {$h/2 + [image height $images(knob)]}] |
|---|
| 492 | |
|---|
| 493 | set w [winfo pixels $itk_component(hull) $itk_option(-length)] |
|---|
| 494 | |
|---|
| 495 | # if the -valuewidth is > 0, then make room for the value |
|---|
| 496 | if {$itk_option(-valuewidth) > 0} { |
|---|
| 497 | set charw [font measure $itk_option(-font) "n"] |
|---|
| 498 | set _vwidth [expr {$itk_option(-valuewidth)*$charw}] |
|---|
| 499 | set w [expr {$w+$_vwidth+4}] |
|---|
| 500 | } else { |
|---|
| 501 | set _vwidth 0 |
|---|
| 502 | } |
|---|
| 503 | |
|---|
| 504 | $itk_component(dial) configure -width $w -height $h |
|---|
| 505 | } |
|---|
| 506 | |
|---|
| 507 | # ---------------------------------------------------------------------- |
|---|
| 508 | # USAGE: _fixValue ?<name1> <name2> <op>? |
|---|
| 509 | # |
|---|
| 510 | # Invoked automatically whenever the -variable associated with this |
|---|
| 511 | # widget is modified. Copies the value to the current settings for |
|---|
| 512 | # the widget. |
|---|
| 513 | # ---------------------------------------------------------------------- |
|---|
| 514 | itcl::body Rappture::Radiodial::_fixValue {args} { |
|---|
| 515 | if {"" == $itk_option(-variable)} { |
|---|
| 516 | return |
|---|
| 517 | } |
|---|
| 518 | upvar #0 $itk_option(-variable) var |
|---|
| 519 | |
|---|
| 520 | set newval $var |
|---|
| 521 | set found 0 |
|---|
| 522 | foreach v $_values { |
|---|
| 523 | if {[string equal $_val2label($v) $newval]} { |
|---|
| 524 | set newval $v |
|---|
| 525 | set found 1 |
|---|
| 526 | break |
|---|
| 527 | } |
|---|
| 528 | } |
|---|
| 529 | if {!$found && "" != $newval} { |
|---|
| 530 | error "bad value \"$newval\"" |
|---|
| 531 | } |
|---|
| 532 | set _current $newval ;# set current directly, so we don't trigger again |
|---|
| 533 | |
|---|
| 534 | after cancel [itcl::code $this _redraw] |
|---|
| 535 | after idle [itcl::code $this _redraw] |
|---|
| 536 | event generate $itk_component(hull) <<Value>> |
|---|
| 537 | } |
|---|
| 538 | |
|---|
| 539 | # ---------------------------------------------------------------------- |
|---|
| 540 | # CONFIGURE: -thickness |
|---|
| 541 | # ---------------------------------------------------------------------- |
|---|
| 542 | itcl::configbody Rappture::Radiodial::thickness { |
|---|
| 543 | _fixSize |
|---|
| 544 | } |
|---|
| 545 | |
|---|
| 546 | # ---------------------------------------------------------------------- |
|---|
| 547 | # CONFIGURE: -length |
|---|
| 548 | # ---------------------------------------------------------------------- |
|---|
| 549 | itcl::configbody Rappture::Radiodial::length { |
|---|
| 550 | _fixSize |
|---|
| 551 | } |
|---|
| 552 | |
|---|
| 553 | # ---------------------------------------------------------------------- |
|---|
| 554 | # CONFIGURE: -font |
|---|
| 555 | # ---------------------------------------------------------------------- |
|---|
| 556 | itcl::configbody Rappture::Radiodial::font { |
|---|
| 557 | _fixSize |
|---|
| 558 | } |
|---|
| 559 | |
|---|
| 560 | # ---------------------------------------------------------------------- |
|---|
| 561 | # CONFIGURE: -valuewidth |
|---|
| 562 | # ---------------------------------------------------------------------- |
|---|
| 563 | itcl::configbody Rappture::Radiodial::valuewidth { |
|---|
| 564 | if {![string is integer $itk_option(-valuewidth)]} { |
|---|
| 565 | error "bad value \"$itk_option(-valuewidth)\": should be integer" |
|---|
| 566 | } |
|---|
| 567 | _fixSize |
|---|
| 568 | after cancel [itcl::code $this _redraw] |
|---|
| 569 | after idle [itcl::code $this _redraw] |
|---|
| 570 | } |
|---|
| 571 | |
|---|
| 572 | # ---------------------------------------------------------------------- |
|---|
| 573 | # CONFIGURE: -dialoutlinecolor |
|---|
| 574 | # ---------------------------------------------------------------------- |
|---|
| 575 | itcl::configbody Rappture::Radiodial::dialoutlinecolor { |
|---|
| 576 | after cancel [itcl::code $this _redraw] |
|---|
| 577 | after idle [itcl::code $this _redraw] |
|---|
| 578 | } |
|---|
| 579 | |
|---|
| 580 | # ---------------------------------------------------------------------- |
|---|
| 581 | # CONFIGURE: -dialfillcolor |
|---|
| 582 | # ---------------------------------------------------------------------- |
|---|
| 583 | itcl::configbody Rappture::Radiodial::dialfillcolor { |
|---|
| 584 | after cancel [itcl::code $this _redraw] |
|---|
| 585 | after idle [itcl::code $this _redraw] |
|---|
| 586 | } |
|---|
| 587 | |
|---|
| 588 | # ---------------------------------------------------------------------- |
|---|
| 589 | # CONFIGURE: -linecolor |
|---|
| 590 | # ---------------------------------------------------------------------- |
|---|
| 591 | itcl::configbody Rappture::Radiodial::linecolor { |
|---|
| 592 | after cancel [itcl::code $this _redraw] |
|---|
| 593 | after idle [itcl::code $this _redraw] |
|---|
| 594 | } |
|---|
| 595 | |
|---|
| 596 | # ---------------------------------------------------------------------- |
|---|
| 597 | # CONFIGURE: -activelinecolor |
|---|
| 598 | # ---------------------------------------------------------------------- |
|---|
| 599 | itcl::configbody Rappture::Radiodial::activelinecolor { |
|---|
| 600 | set val $itk_option(-activelinecolor) |
|---|
| 601 | if {[catch {$val isa ::Rappture::Spectrum} valid] == 0 && $valid} { |
|---|
| 602 | set _spectrum $val |
|---|
| 603 | set _activecolor "" |
|---|
| 604 | } elseif {[catch {winfo rgb $itk_component(hull) $val}] == 0} { |
|---|
| 605 | set _spectrum "" |
|---|
| 606 | set _activecolor $val |
|---|
| 607 | } else { |
|---|
| 608 | error "bad value \"$val\": should be Spectrum object or color" |
|---|
| 609 | } |
|---|
| 610 | after cancel [itcl::code $this _redraw] |
|---|
| 611 | after idle [itcl::code $this _redraw] |
|---|
| 612 | } |
|---|
| 613 | |
|---|
| 614 | # ---------------------------------------------------------------------- |
|---|
| 615 | # CONFIGURE: -variable |
|---|
| 616 | # ---------------------------------------------------------------------- |
|---|
| 617 | itcl::configbody Rappture::Radiodial::variable { |
|---|
| 618 | if {"" != $_variable} { |
|---|
| 619 | upvar #0 $_variable var |
|---|
| 620 | trace remove variable var write [itcl::code $this _fixValue] |
|---|
| 621 | } |
|---|
| 622 | |
|---|
| 623 | set _variable $itk_option(-variable) |
|---|
| 624 | |
|---|
| 625 | if {"" != $_variable} { |
|---|
| 626 | upvar #0 $_variable var |
|---|
| 627 | trace add variable var write [itcl::code $this _fixValue] |
|---|
| 628 | |
|---|
| 629 | # sync to the current value of this variable |
|---|
| 630 | if {[info exists var]} { |
|---|
| 631 | _fixValue |
|---|
| 632 | } |
|---|
| 633 | } |
|---|
| 634 | } |
|---|
