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

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

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