source: trunk/gui/scripts/flowdial.tcl @ 1916

Last change on this file since 1916 was 1916, checked in by dkearney, 14 years ago

switching from RpMediaPlayer? to RpVideo? code for the video viewer widget. changed flowdial widget so the dial moved as needed for the video widget.

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