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

Last change on this file since 115 was 115, checked in by mmc, 19 years ago

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