source: trunk/gui/scripts/radiodial.tcl @ 2505

Last change on this file since 2505 was 1929, checked in by gah, 14 years ago
File size: 28.0 KB
Line 
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# ======================================================================
14package require Itk
15
16option add *Radiodial.thickness 10 widgetDefault
17option add *Radiodial.length 2i widgetDefault
18option add *Radiodial.knobImage knob widgetDefault
19option add *Radiodial.knobPosition n@middle widgetDefault
20option add *Radiodial.dialOutlineColor black widgetDefault
21option add *Radiodial.dialFillColor white widgetDefault
22option add *Radiodial.lineColor gray widgetDefault
23option add *Radiodial.activeLineColor black widgetDefault
24option add *Radiodial.padding 0 widgetDefault
25option add *Radiodial.valueWidth 10 widgetDefault
26option add *Radiodial.valuePadding 0.1 widgetDefault
27option add *Radiodial.foreground black widgetDefault
28option add *Radiodial.font \
29    -*-helvetica-medium-r-normal-*-12-* widgetDefault
30
31itcl::class Rappture::Radiodial {
32    inherit itk::Widget
33
34    itk_option define -min min Min ""
35    itk_option define -max max Max ""
36    itk_option define -variable variable Variable ""
37
38    itk_option define -thickness thickness Thickness 0
39    itk_option define -length length Length 0
40    itk_option define -padding padding Padding 0
41
42    itk_option define -foreground foreground Foreground "black"
43    itk_option define -dialoutlinecolor dialOutlineColor Color "black"
44    itk_option define -dialfillcolor dialFillColor Color "white"
45    itk_option define -dialprogresscolor dialProgressColor Color ""
46    itk_option define -linecolor lineColor Color "black"
47    itk_option define -activelinecolor activeLineColor Color "black"
48    itk_option define -knobimage knobImage KnobImage ""
49    itk_option define -knobposition knobPosition KnobPosition ""
50
51    itk_option define -font font Font ""
52    itk_option define -valuewidth valueWidth ValueWidth 0
53    itk_option define -valuepadding valuePadding ValuePadding 0
54
55
56    constructor {args} { # defined below }
57    destructor { # defined below }
58
59    public method add {label {value ""}}
60    public method clear {}
61    public method get {args}
62    public method current {args}
63    public method color {value}
64                                                                               
65    protected method _setCurrent {val}
66    protected method _redraw {}
67    protected method _click {x y}
68    protected method _navigate {offset}
69    protected method _limits {}
70    protected method _findLabel {str}
71    protected method _fixSize {}
72    protected method _fixValue {args}
73
74    private variable _values ""       ;# list of all values on the dial
75    private variable _val2label       ;# maps value => string label(s)
76    private variable _current ""      ;# current value (where pointer is)
77    private variable _variable ""     ;# variable associated with -variable
78
79    private variable _knob ""         ;# image for knob
80    private variable _spectrum ""     ;# width allocated for values
81    private variable _activecolor ""  ;# width allocated for values
82    private variable _vwidth 0        ;# width allocated for values
83}
84                                                                               
85itk::usual Radiodial {
86    keep -background -foreground -cursor -font
87}
88
89# ----------------------------------------------------------------------
90# CONSTRUCTOR
91# ----------------------------------------------------------------------
92itcl::body Rappture::Radiodial::constructor {args} {
93    itk_component add dial {
94        canvas $itk_interior.dial
95    }
96    pack $itk_component(dial) -expand yes -fill both
97    bind $itk_component(dial) <Configure> [itcl::code $this _redraw]
98
99    bind $itk_component(dial) <ButtonPress-1> [itcl::code $this _click %x %y]
100    bind $itk_component(dial) <B1-Motion> [itcl::code $this _click %x %y]
101    bind $itk_component(dial) <ButtonRelease-1> [itcl::code $this _click %x %y]
102
103    bind $itk_component(hull) <KeyPress-Left> [itcl::code $this _navigate -1]
104    bind $itk_component(hull) <KeyPress-Right> [itcl::code $this _navigate 1]
105
106    eval itk_initialize $args
107
108    _fixSize
109}
110
111# ----------------------------------------------------------------------
112# DESTRUCTOR
113# ----------------------------------------------------------------------
114itcl::body Rappture::Radiodial::destructor {} {
115    configure -variable ""  ;# remove variable trace
116    after cancel [itcl::code $this _redraw]
117}
118
119# ----------------------------------------------------------------------
120# USAGE: add <label> ?<value>?
121#
122# Clients use this to add new values to the dial.  Values are always
123# sorted in order along the dial.  If the value is not specified,
124# then it is created automatically based on the number of elements
125# on the dial.
126# ----------------------------------------------------------------------
127itcl::body Rappture::Radiodial::add {label {value ""}} {
128    if {"" == $value} {
129        set value [llength $_values]
130    }
131
132    # Add this value if we've never see it before
133    if {[lsearch -real $_values $value] < 0} {
134        lappend _values $value
135        set _values [lsort -real $_values]
136    }
137
138    # Keep all equivalent strings for this value.
139    # That way, we can later select either "1e18" or "1.0e+18"
140    lappend _val2label($value) $label
141
142    if {"" == $_current} {
143        _setCurrent $value
144    }
145
146    after cancel [itcl::code $this _redraw]
147    after idle [itcl::code $this _redraw]
148}
149
150# ----------------------------------------------------------------------
151# USAGE: clear
152#
153# Clients use this to remove all existing values from the dial.
154# ----------------------------------------------------------------------
155itcl::body Rappture::Radiodial::clear {} {
156    set _values ""
157    _setCurrent ""
158    catch {unset _val2label}
159
160    after cancel [itcl::code $this _redraw]
161    after idle [itcl::code $this _redraw]
162}
163
164# ----------------------------------------------------------------------
165# USAGE: get ?-format what? ?current|@index?
166#
167# Clients use this to query values within this radiodial.  With no
168# args, it returns a list of all values stored in the widget.  The
169# "current" arg requests only the current value on the radiodial.
170# The @index syntax can be used to request a particular value at
171# an index within the list of values.
172#
173# By default, this method returns the label for each value.  The
174# format option can be used to request the label, the value, or
175# both.
176# ----------------------------------------------------------------------
177itcl::body Rappture::Radiodial::get {args} {
178    Rappture::getopts args params {
179        value -format "label"
180    }
181    if {[llength $args] > 1} {
182        error "wrong # args: should be \"get ?-format f? ?current|@index\""
183    }
184    set index [lindex $args 0]
185    if {"" == $index} {
186        set ilist ""
187        for {set i 0} {$i < [llength $_values]} {incr i} {
188            lappend ilist $i
189        }
190    } elseif {"current" == $index} {
191        set ilist [lsearch -exact $_values $_current]
192        if {$ilist < 0} {
193            set ilist ""
194        }
195    } elseif {[regexp {^@([0-9]+|end)$} $index match i]} {
196        set ilist $i
197    }
198    if {[llength $ilist] == 1} {
199        set op set
200    } else {
201        set op lappend
202    }
203
204    set rlist ""
205    foreach i $ilist {
206        switch -- $params(-format) {
207            label {
208                set v [lindex $_values $i]
209                $op rlist [lindex $_val2label($v) 0]
210            }
211            value {
212                $op rlist [lindex $_values $i]
213            }
214            position {
215                foreach {min max} [_limits] break
216                set v [lindex $_values $i]
217                set frac [expr {double($v-$min)/($max-$min)}]
218                $op rlist $frac
219            }
220            all {
221                set v [lindex $_values $i]
222                foreach {min max} [_limits] break
223                set frac [expr {double($v-$min)/($max-$min)}]
224                set l [lindex $_val2label($v) 0]
225                $op rlist [list $l $v $frac]
226            }
227            default {
228                error "bad value \"$v\": should be label, value, position, all"
229            }
230        }
231    }
232    return $rlist
233}
234
235# ----------------------------------------------------------------------
236# USAGE: current ?<newval>?
237#
238# Clients use this to get/set the current value for this widget.
239# ----------------------------------------------------------------------
240itcl::body Rappture::Radiodial::current {args} {
241    if {[llength $args] == 0} {
242        return $_current
243    } elseif {[llength $args] == 1} {
244        set newval [lindex $args 0]
245        set n [_findLabel $newval]
246
247        # Don't use expr (?:) because it evaluates the resulting string.
248        # For example, it changes -0.020 to -0.02.
249        if { $n >= 0 } {
250            set rawval [lindex $_values $n]
251        } else {
252            set rawval ""
253        }
254        _setCurrent $rawval
255
256        after cancel [itcl::code $this _redraw]
257        after idle [itcl::code $this _redraw]
258        event generate $itk_component(hull) <<Value>>
259
260        return $_current
261    }
262    error "wrong # args: should be \"current ?newval?\""
263}
264
265# ----------------------------------------------------------------------
266# USAGE: color <value>
267#
268# Clients use this to query the color associated with a <value>
269# along the dial.
270# ----------------------------------------------------------------------
271itcl::body Rappture::Radiodial::color {value} {
272    _findLabel $value  ;# make sure this label is recognized
273
274    if {"" != $_spectrum} {
275        foreach {min max} [_limits] break
276        set frac [expr {double($value-$min)/($max-$min)}]
277        set color [$_spectrum get $frac]
278    } else {
279        if {$value == $_current} {
280            set color $_activecolor
281        } else {
282            set color $itk_option(-linecolor)
283        }
284    }
285    return $color
286}
287
288# ----------------------------------------------------------------------
289# USAGE: _setCurrent <value>
290#
291# Called automatically whenever the widget changes size to redraw
292# all elements within it.
293# ----------------------------------------------------------------------
294itcl::body Rappture::Radiodial::_setCurrent {value} {
295    set _current $value
296    if {"" != $_variable} {
297        upvar #0 $_variable var
298        if {[info exists _val2label($value)]} {
299            set var [lindex $_val2label($value) 0]
300        } else {
301            set var $value
302        }
303    }
304}
305
306# ----------------------------------------------------------------------
307# USAGE: _redraw
308#
309# Called automatically whenever the widget changes size to redraw
310# all elements within it.
311# ----------------------------------------------------------------------
312itcl::body Rappture::Radiodial::_redraw {} {
313    set c $itk_component(dial)
314    $c delete all
315
316    set fg $itk_option(-foreground)
317
318    set w [winfo width $c]
319    set h [winfo height $c]
320    set p [winfo pixels $c $itk_option(-padding)]
321    set t [expr {$itk_option(-thickness)+1}]
322    set y1 [expr {$h-1}]
323
324    if {"" != $_knob} {
325        set kw [image width $_knob]
326        set kh [image height $_knob]
327
328        switch -- $itk_option(-knobposition) {
329            n@top - nw@top - ne@top {
330                set extra [expr {$t-$kh}]
331                if {$extra < 0} {set extra 0}
332                set y1 [expr {$h-$extra-1}]
333            }
334            n@middle - nw@middle - ne@middle {
335                set extra [expr {int(ceil($kh-0.5*$t))}]
336                if {$extra < 0} {set extra 0}
337                set y1 [expr {$h-$extra-1}]
338            }
339            n@bottom - nw@bottom - ne@bottom {
340                set y1 [expr {$h-$kh-1}]
341            }
342
343            e@top - w@top - center@top -
344            e@bottom - w@bottom - center@bottom {
345                set extra [expr {int(ceil(0.5*$kh))}]
346                set y1 [expr {$h-$extra-1}]
347            }
348            e@middle - w@middle - center@middle {
349                set extra [expr {int(ceil(0.5*($kh-$t)))}]
350                if {$extra < 0} {set extra 0}
351                set y1 [expr {$h-$extra-1}]
352            }
353
354            s@top - sw@top - se@top -
355            s@middle - sw@middle - se@middle -
356            s@bottom - sw@bottom - se@bottom {
357                set y1 [expr {$h-2}]
358            }
359        }
360    }
361    set y0 [expr {$y1-$t}]
362    set x0 [expr {$p+1}]
363    set x1 [expr {$w-$_vwidth-$p-4}]
364    foreach {min max} [_limits] break
365
366    # draw the background rectangle
367    $c create rectangle $x0 $y0 $x1 $y1 \
368        -outline $itk_option(-dialoutlinecolor) \
369        -fill $itk_option(-dialfillcolor)
370
371    # draw the optional progress bar, from start to current
372    if {"" != $itk_option(-dialprogresscolor)
373          && [llength $_values] > 0 && "" != $_current} {
374        if {$max != $min} {
375            set frac [expr {double($_current-$min)/($max-$min)}]
376        } else {
377            set frac 0.
378        }
379        set xx1 [expr {$frac*($x1-$x0) + $x0}]
380        $c create rectangle [expr {$x0+1}] [expr {$y0+3}] $xx1 [expr {$y1-2}] \
381            -outline "" -fill $itk_option(-dialprogresscolor)
382    }
383
384    # draw lines for all values
385    if {$max > $min} {
386        foreach v $_values {
387            set frac [expr {double($v-$min)/($max-$min)}]
388            if {"" != $_spectrum} {
389                set color [$_spectrum get $frac]
390            } else {
391                if {$v == $_current} {
392                    set color $_activecolor
393                } else {
394                    set color $itk_option(-linecolor)
395                }
396            }
397            set thick [expr {($v == $_current) ? 3 : 1}]
398
399            if {"" != $color} {
400                set x [expr {$frac*($x1-$x0) + $x0}]
401                $c create line $x [expr {$y0+1}] $x $y1 \
402                    -fill $color -width $thick
403            }
404        }
405
406        if {"" != $_current} {
407            set x [expr {double($_current-$min)/($max-$min)*($x1-$x0) + $x0}]
408            regexp {([nsew]+|center)@} $itk_option(-knobposition) match anchor
409            switch -glob -- $itk_option(-knobposition) {
410                *@top    { set kpos $y0 }
411                *@middle { set kpos [expr {int(ceil(0.5*($y1+$y0)))}] }
412                *@bottom { set kpos $y1 }
413            }
414            $c create image $x $kpos -anchor $anchor -image $_knob
415        }
416    }
417
418    # if the -valuewidth is > 0, then make room for the value
419    set vw $itk_option(-valuewidth)
420    if {$vw > 0 && "" != $_current} {
421        set str [lindex $_val2label($_current) 0]
422        if {[string length $str] >= $vw} {
423            set str "[string range $str 0 [expr {$vw-3}]]..."
424        }
425
426        set dy [expr {([font metrics $itk_option(-font) -linespace]
427                        - [font metrics $itk_option(-font) -ascent])/2}]
428
429        set id [$c create text [expr {$x1+4}] [expr {($y1+$y0)/2+$dy}] \
430            -anchor w -text $str -font $itk_option(-font) -foreground $fg]
431        foreach {x0 y0 x1 y1} [$c bbox $id] break
432        set x0 [expr {$x0 + 10}]
433
434        # set up a tooltip so you can mouse over truncated values
435        Rappture::Tooltip::text $c [lindex $_val2label($_current) 0]
436        $c bind $id <Enter> \
437            [list ::Rappture::Tooltip::tooltip pending %W +$x0,$y1]
438        $c bind $id <Leave> \
439            [list ::Rappture::Tooltip::tooltip cancel]
440        $c bind $id <ButtonPress> \
441            [list ::Rappture::Tooltip::tooltip cancel]
442        $c bind $id <KeyPress> \
443            [list ::Rappture::Tooltip::tooltip cancel]
444    }
445}
446
447# ----------------------------------------------------------------------
448# USAGE: _click <x> <y>
449#
450# Called automatically whenever the user clicks or drags on the widget
451# to select a value.  Moves the current value to the one nearest the
452# click point.  If the value actually changes, it generates a <<Value>>
453# event to notify clients.
454# ----------------------------------------------------------------------
455itcl::body Rappture::Radiodial::_click {x y} {
456    set c $itk_component(dial)
457    set w [winfo width $c]
458    set h [winfo height $c]
459    set x0 1
460    set x1 [expr {$w-$_vwidth-4}]
461
462    focus $itk_component(hull)
463
464    # draw lines for all values
465    foreach {min max} [_limits] break
466    if {$max > $min && $x >= $x0 && $x <= $x1} {
467        set dmin $w
468        set xnearest 0
469        set vnearest ""
470        foreach v $_values {
471            set xv [expr {double($v-$min)/($max-$min)*($x1-$x0) + $x0}]
472            if {abs($xv-$x) < $dmin} {
473                set dmin [expr {abs($xv-$x)}]
474                set xnearest $xv
475                set vnearest $v
476            }
477        }
478
479        if {$vnearest != $_current} {
480            _setCurrent $vnearest
481            _redraw
482
483            event generate $itk_component(hull) <<Value>>
484        }
485    }
486}
487
488# ----------------------------------------------------------------------
489# USAGE: _navigate <offset>
490#
491# Called automatically whenever the user presses left/right keys
492# to nudge the current value left or right by some <offset>.  If the
493# value actually changes, it generates a <<Value>> event to notify
494# clients.
495# ----------------------------------------------------------------------
496itcl::body Rappture::Radiodial::_navigate {offset} {
497    set index [lsearch -exact $_values $_current]
498    if {$index >= 0} {
499        incr index $offset
500        if {$index >= [llength $_values]} {
501            set index [expr {[llength $_values]-1}]
502        } elseif {$index < 0} {
503            set index 0
504        }
505
506        set newval [lindex $_values $index]
507        if {$newval != $_current} {
508            _setCurrent $newval
509            _redraw
510
511            event generate $itk_component(hull) <<Value>>
512        }
513    }
514}
515
516# ----------------------------------------------------------------------
517# USAGE: _limits
518#
519# Used internally to compute the overall min/max limits for the
520# radio dial.  Returns {min max}, representing the end values for
521# the scale.
522# ----------------------------------------------------------------------
523itcl::body Rappture::Radiodial::_limits {} {
524    if {[llength $_values] == 0} {
525        set min 0
526        set max 0
527    } else {
528        set min [lindex $_values 0]
529        set max $min
530        foreach v [lrange $_values 1 end] {
531            if {$v < $min} { set min $v }
532            if {$v > $max} { set max $v }
533        }
534        set del [expr {$max-$min}]
535        set min [expr {$min-$itk_option(-valuepadding)*$del}]
536        set max [expr {$max+$itk_option(-valuepadding)*$del}]
537    }
538
539    if {"" != $itk_option(-min)} {
540        set min $itk_option(-min)
541    }
542    if {"" != $itk_option(-max)} {
543        set max $itk_option(-max)
544    }
545    return [list $min $max]
546}
547
548# ----------------------------------------------------------------------
549# USAGE: _findLabel <string>
550#
551# Used internally to search for the given <string> label among the
552# known values.  Returns an index into the _values list, or throws
553# an error if the string is not recognized.  Given the null string,
554# it returns -1, indicating that the value is not in _values, but
555# it is valid.
556# ----------------------------------------------------------------------
557itcl::body Rappture::Radiodial::_findLabel {str} {
558    if {"" == $str} {
559        return -1
560    }
561    for {set nv 0} {$nv < [llength $_values]} {incr nv} {
562        set v [lindex $_values $nv]
563        if {[lsearch -exact $_val2label($v) $str] >= 0} {
564            return $nv
565        }
566    }
567    error "bad value \"$str\": should be something matching the raw values \"[join $_values ,]\""
568}
569
570# ----------------------------------------------------------------------
571# USAGE: _fixSize
572#
573# Used internally to compute the overall size of the widget based
574# on the -thickness and -length options.
575# ----------------------------------------------------------------------
576itcl::body Rappture::Radiodial::_fixSize {} {
577    set h [winfo pixels $itk_component(hull) $itk_option(-thickness)]
578
579    if {"" != $_knob} {
580        set kh [image height $_knob]
581
582        switch -- $itk_option(-knobposition) {
583            n@top - nw@top - ne@top -
584            s@bottom - sw@bottom - se@bottom {
585                if {$kh > $h} { set h $kh }
586            }
587            n@middle - nw@middle - ne@middle -
588            s@middle - sw@middle - se@middle {
589                set h [expr {int(ceil(0.5*$h + $kh))}]
590            }
591            n@bottom - nw@bottom - ne@bottom -
592            s@top - sw@top - se@top {
593                set h [expr {$h + $kh}]
594            }
595            e@middle - w@middle - center@middle {
596                set h [expr {(($h > $kh) ? $h : $kh) + 1}]
597            }
598            n@middle - ne@middle - nw@middle -
599            s@middle - se@middle - sw@middle {
600                set extra [expr {int(ceil($kh-0.5*$h))}]
601                if {$extra < 0} { set extra 0 }
602                set h [expr {$h+$extra}]
603            }
604        }
605    }
606    incr h 1
607
608    set w [winfo pixels $itk_component(hull) $itk_option(-length)]
609
610    # if the -valuewidth is > 0, then make room for the value
611    if {$itk_option(-valuewidth) > 0} {
612        set charw [font measure $itk_option(-font) "n"]
613        set _vwidth [expr {$itk_option(-valuewidth)*$charw}]
614        set w [expr {$w+$_vwidth+4}]
615    } else {
616        set _vwidth 0
617    }
618
619    $itk_component(dial) configure -width $w -height $h
620}
621
622# ----------------------------------------------------------------------
623# USAGE: _fixValue ?<name1> <name2> <op>?
624#
625# Invoked automatically whenever the -variable associated with this
626# widget is modified.  Copies the value to the current settings for
627# the widget.
628# ----------------------------------------------------------------------
629itcl::body Rappture::Radiodial::_fixValue {args} {
630    if {"" == $itk_option(-variable)} {
631        return
632    }
633    upvar #0 $itk_option(-variable) var
634
635    set newval $var
636    set n [_findLabel $newval]
637    set rawval [expr {($n >= 0) ? [lindex $_values $n] : ""}]
638    set _current $rawval  ;# set current directly, so we don't trigger again
639
640    after cancel [itcl::code $this _redraw]
641    after idle [itcl::code $this _redraw]
642    event generate $itk_component(hull) <<Value>>
643}
644
645# ----------------------------------------------------------------------
646# CONFIGURE: -thickness
647# ----------------------------------------------------------------------
648itcl::configbody Rappture::Radiodial::thickness {
649    _fixSize
650}
651
652# ----------------------------------------------------------------------
653# CONFIGURE: -length
654# ----------------------------------------------------------------------
655itcl::configbody Rappture::Radiodial::length {
656    _fixSize
657}
658
659# ----------------------------------------------------------------------
660# CONFIGURE: -font
661# ----------------------------------------------------------------------
662itcl::configbody Rappture::Radiodial::font {
663    _fixSize
664}
665
666# ----------------------------------------------------------------------
667# CONFIGURE: -valuewidth
668# ----------------------------------------------------------------------
669itcl::configbody Rappture::Radiodial::valuewidth {
670    if {![string is integer $itk_option(-valuewidth)]} {
671        error "bad value \"$itk_option(-valuewidth)\": should be integer"
672    }
673    _fixSize
674    after cancel [itcl::code $this _redraw]
675    after idle [itcl::code $this _redraw]
676}
677
678# ----------------------------------------------------------------------
679# CONFIGURE: -foreground
680# ----------------------------------------------------------------------
681itcl::configbody Rappture::Radiodial::foreground {
682    after cancel [itcl::code $this _redraw]
683    after idle [itcl::code $this _redraw]
684}
685
686# ----------------------------------------------------------------------
687# CONFIGURE: -dialoutlinecolor
688# ----------------------------------------------------------------------
689itcl::configbody Rappture::Radiodial::dialoutlinecolor {
690    after cancel [itcl::code $this _redraw]
691    after idle [itcl::code $this _redraw]
692}
693
694# ----------------------------------------------------------------------
695# CONFIGURE: -dialfillcolor
696# ----------------------------------------------------------------------
697itcl::configbody Rappture::Radiodial::dialfillcolor {
698    after cancel [itcl::code $this _redraw]
699    after idle [itcl::code $this _redraw]
700}
701
702# ----------------------------------------------------------------------
703# CONFIGURE: -dialprogresscolor
704# ----------------------------------------------------------------------
705itcl::configbody Rappture::Radiodial::dialprogresscolor {
706    after cancel [itcl::code $this _redraw]
707    after idle [itcl::code $this _redraw]
708}
709
710# ----------------------------------------------------------------------
711# CONFIGURE: -linecolor
712# ----------------------------------------------------------------------
713itcl::configbody Rappture::Radiodial::linecolor {
714    after cancel [itcl::code $this _redraw]
715    after idle [itcl::code $this _redraw]
716}
717
718# ----------------------------------------------------------------------
719# CONFIGURE: -activelinecolor
720# ----------------------------------------------------------------------
721itcl::configbody Rappture::Radiodial::activelinecolor {
722    set val $itk_option(-activelinecolor)
723    if {[catch {$val isa ::Rappture::Spectrum} valid] == 0 && $valid} {
724        set _spectrum $val
725        set _activecolor ""
726    } elseif {[catch {winfo rgb $itk_component(hull) $val}] == 0} {
727        set _spectrum ""
728        set _activecolor $val
729    } elseif {"" != $val} {
730        error "bad value \"$val\": should be Spectrum object or color"
731    }
732    after cancel [itcl::code $this _redraw]
733    after idle [itcl::code $this _redraw]
734}
735
736# ----------------------------------------------------------------------
737# CONFIGURE: -knobimage
738# ----------------------------------------------------------------------
739itcl::configbody Rappture::Radiodial::knobimage {
740    if {[regexp {^image[0-9]+$} $itk_option(-knobimage)]} {
741        set _knob $itk_option(-knobimage)
742    } elseif {"" != $itk_option(-knobimage)} {
743        set _knob [Rappture::icon $itk_option(-knobimage)]
744    } else {
745        set _knob ""
746    }
747    _fixSize
748
749    after cancel [itcl::code $this _redraw]
750    after idle [itcl::code $this _redraw]
751}
752
753# ----------------------------------------------------------------------
754# CONFIGURE: -knobposition
755# ----------------------------------------------------------------------
756itcl::configbody Rappture::Radiodial::knobposition {
757    if {![regexp {^([nsew]+|center)@(top|middle|bottom)$} $itk_option(-knobposition)]} {
758        error "bad value \"$itk_option(-knobposition)\": should be anchor@top|middle|bottom"
759    }
760    _fixSize
761
762    after cancel [itcl::code $this _redraw]
763    after idle [itcl::code $this _redraw]
764}
765
766# ----------------------------------------------------------------------
767# CONFIGURE: -padding
768# This adds padding on left/right side of dial background.
769# ----------------------------------------------------------------------
770itcl::configbody Rappture::Radiodial::padding {
771    if {[catch {winfo pixels $itk_component(hull) $itk_option(-padding)}]} {
772        error "bad value \"$itk_option(-padding)\": should be size in pixels"
773    }
774}
775
776# ----------------------------------------------------------------------
777# CONFIGURE: -valuepadding
778# This shifts min/max limits in by a fraction of the overall size.
779# ----------------------------------------------------------------------
780itcl::configbody Rappture::Radiodial::valuepadding {
781    if {![string is double $itk_option(-valuepadding)]
782          || $itk_option(-valuepadding) < 0} {
783        error "bad value \"$itk_option(-valuepadding)\": should be >= 0.0"
784    }
785}
786
787# ----------------------------------------------------------------------
788# CONFIGURE: -variable
789# ----------------------------------------------------------------------
790itcl::configbody Rappture::Radiodial::variable {
791    if {"" != $_variable} {
792        upvar #0 $_variable var
793        trace remove variable var write [itcl::code $this _fixValue]
794    }
795
796    set _variable $itk_option(-variable)
797
798    if {"" != $_variable} {
799        upvar #0 $_variable var
800        trace add variable var write [itcl::code $this _fixValue]
801
802        # sync to the current value of this variable
803        if {[info exists var]} {
804            _fixValue
805        }
806    }
807}
Note: See TracBrowser for help on using the repository browser.