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

Last change on this file since 3177 was 3177, checked in by mmc, 12 years ago

Updated all of the copyright notices to reference the transfer to
the new HUBzero Foundation, LLC.
File size: 21.0 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-2012  HUBzero Foundation, LLC
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.