source: branches/1.3/gui/scripts/flowdial.tcl @ 4743

Last change on this file since 4743 was 3330, checked in by gah, 12 years ago

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