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

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

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