source: trunk/gui/scripts/videodial1.tcl @ 4344

Last change on this file since 4344 was 3330, checked in by gah, 11 years ago

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