source: trunk/gui/scripts/videopreview.tcl @ 2028

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

video widget updates
various bug fixes
File size: 17.5 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: videopreview - previewing movies
3#
4# ======================================================================
5#  AUTHOR:  Derrick Kearney, Purdue University
6#  Copyright (c) 2005-2010  Purdue Research Foundation
7#
8# See the file "license.terms" for information on usage and redistribution of
9# this file, and for a DISCLAIMER OF ALL WARRANTIES.
10# ======================================================================
11
12package require Itk
13package require BLT
14package require Img
15package require Rappture
16package require RapptureGUI
17
18option add *Video.width 300 widgetDefault
19option add *Video.height 300 widgetDefault
20option add *Video.font \
21    -*-helvetica-medium-r-normal-*-12-* widgetDefault
22
23itcl::class Rappture::VideoPreview {
24    inherit itk::Widget
25
26    itk_option define -width width Width -1
27    itk_option define -height height Height -1
28    itk_option define -variable variable Variable ""
29
30    constructor { args } {
31        # defined below
32    }
33    destructor {
34        # defined below
35    }
36
37    public method load {type data}
38    public method loadcb {args}
39    public method video {args}
40    public method query {type}
41
42    protected method Play {}
43    protected method Seek {n}
44    protected method fixSize {}
45    protected method _fixValue {args}
46    protected method Upload {args}
47    protected method eventually {args}
48
49
50    private common   _settings
51    private common   _pendings
52
53    private variable _variable ""   ;# quick way to change movie
54    private variable _path  ""      ;# path of movie
55    private variable _width -1      ;# start x for rubberbanding
56    private variable _height -1     ;# start x for rubberbanding
57    private variable _movie ""      ;# movie we grab images from
58    private variable _lastFrame 0   ;# last frame in the movie
59    private variable _imh ""        ;# current image being displayed
60    private variable _id ""         ;# id of the next play command from after
61    private variable _framerate 30  ;# video frame rate
62    private variable _mspf  7       ;# milliseconds per frame wait time
63    private variable _ofrd  19      ;# observed frame retrieval delay of
64                                    ;# underlying c lib in milliseconds
65    private variable _delay  0      ;# milliseconds between play calls
66    private variable _nextframe 0   ;#
67}
68
69
70itk::usual VideoPreview {
71}
72
73# ----------------------------------------------------------------------
74# CONSTRUCTOR
75# ----------------------------------------------------------------------
76itcl::body Rappture::VideoPreview::constructor {args} {
77
78    array set _settings [subst {
79        $this-framenum          0
80        $this-play              0
81    }]
82
83    array set _pendings [subst {
84        play 0
85    }]
86
87    itk_component add main {
88        canvas $itk_interior.main \
89            -background black
90    } {
91        usual
92        rename -background -controlbackground controlBackground Background
93    }
94    bind $itk_component(main) <Configure> [itcl::code $this fixSize]
95
96    # hold the video frames in an image on the canvas
97    set _imh [image create photo]
98    $itk_component(main) create image 0 0 -anchor nw -image $_imh
99
100    # setup movie controls
101    itk_component add moviecontrols {
102        frame $itk_interior.moviecontrols
103    } {
104        usual
105        rename -background -controlbackground controlBackground Background
106    }
107
108    # setup frame number frame
109    itk_component add frnumfr {
110        frame $itk_component(moviecontrols).frnumfr
111    } {
112        usual
113        rename -background -controlbackground controlBackground Background
114    }
115
116    set imagesDir [file join $RapptureGUI::library scripts images]
117
118
119    # Play
120    itk_component add play {
121        Rappture::PushButton $itk_component(moviecontrols).play \
122            -onimage [Rappture::icon flow-pause] \
123            -offimage [Rappture::icon flow-play] \
124            -disabledimage [Rappture::icon flow-play] \
125            -variable [itcl::scope _settings($this-play)] \
126            -command [itcl::code $this video play]
127    }
128    set fg [option get $itk_component(hull) font Font]
129    Rappture::Tooltip::for $itk_component(play) \
130        "Play/Pause movie"
131    $itk_component(play) disable
132
133    # Video Dial Major
134    itk_component add dialmajor {
135        Rappture::Videodial1 $itk_component(moviecontrols).dialmajor \
136            -length 10 -valuewidth 0 -valuepadding 0 -padding 6 \
137            -linecolor "" -activelinecolor "" \
138            -min 0 -max 1 \
139            -variable [itcl::scope _settings($this-framenum)] \
140            -dialoutlinecolor black \
141            -knobimage [Rappture::icon knob2] -knobposition center@middle
142    } {
143        usual
144        ignore -dialprogresscolor
145        rename -background -controlbackground controlBackground Background
146    }
147    $itk_component(dialmajor) current 0
148    bind $itk_component(dialmajor) <<Value>> [itcl::code $this video update]
149
150    itk_component add framenumlabel {
151        label $itk_component(frnumfr).framenuml -text "Frame:" -font $fg \
152            -highlightthickness 0
153    } {
154        usual
155        ignore -highlightthickness
156        rename -background -controlbackground controlBackground Background
157    }
158
159    # Current Frame Number
160    itk_component add framenum {
161        label $itk_component(frnumfr).framenum \
162            -width 5 -font "arial 9" \
163            -textvariable [itcl::scope _settings($this-framenum)]
164    } {
165        usual
166        ignore -highlightthickness
167        rename -background -controlbackground controlBackground Background
168    }
169    Rappture::Tooltip::for $itk_component(framenum) \
170        "Current frame number"
171
172
173    pack $itk_component(framenumlabel) -side left
174    pack $itk_component(framenum) -side right
175
176
177    blt::table $itk_component(moviecontrols) \
178        0,0 $itk_component(play) -padx {2 0} \
179        0,1 $itk_component(dialmajor) -fill x -padx {2 2} \
180        0,2 $itk_component(frnumfr) -padx {2 4}
181
182    blt::table configure $itk_component(moviecontrols) c* -resize none
183    blt::table configure $itk_component(moviecontrols) c1 -resize both
184    blt::table configure $itk_component(moviecontrols) r0 -pady 1
185
186
187    blt::table $itk_interior \
188        0,0 $itk_component(main) -fill both \
189        1,0 $itk_component(moviecontrols) -fill x
190    blt::table configure $itk_interior c* -resize both
191    blt::table configure $itk_interior r0 -resize both
192    blt::table configure $itk_interior r1 -resize both
193
194    eval itk_initialize $args
195
196    $itk_component(main) configure -background black
197}
198
199# ----------------------------------------------------------------------
200# DESTRUCTOR
201# ----------------------------------------------------------------------
202itcl::body Rappture::VideoPreview::destructor {} {
203    array unset _settings $this-*
204    if {[info exists _imh]} {
205        image delete $_imh
206    }
207}
208
209# ----------------------------------------------------------------------
210# load - load a video file
211#   type - type of data, "data" or "file"
212#   data - what to load.
213#       if type == "data", data is treated like binary data
214#       if type == "file", data is treated like the name of a file
215#           and is opened and then loaded.
216# ----------------------------------------------------------------------
217itcl::body Rappture::VideoPreview::load {type data} {
218
219    # open the file
220
221    set fname ""
222    switch $type {
223        "data" {
224            set fname "/tmp/tmpVV[pid].video"
225            set fid [open $fname "w"]
226            fconfigure $fid -translation binary -encoding binary
227            puts $fid $data
228            close $fid
229            set type "file"
230            set data $fname
231        }
232        "file" {
233            # do nothing
234        }
235        default {
236            error "bad value: \"$type\": should be \"load \[data|file\] <data>\""
237        }
238    }
239
240    video stop
241
242    if {([info exists _movie]) && ("" != ${_movie})} {
243        ${_movie} release
244    }
245
246    set _movie [Rappture::Video $type $data]
247    file delete $fname
248    set _framerate [${_movie} get framerate]
249    set _mspf [expr round(((1.0/${_framerate})*1000))]
250    set _delay [expr {${_mspf} - ${_ofrd}}]
251
252    video seek 0
253
254    # update the dial and framenum widgets
255    set _settings($this-framenum) 0
256
257    # setup the image display
258
259    foreach {w h} [query dimensions] break
260    if {${_width} == -1} {
261        set _width $w
262    }
263    if {${_height} == -1} {
264        set _height $h
265    }
266
267    set _lastFrame [$_movie get position end]
268
269    # update the dial with video information
270    $itk_component(dialmajor) configure -min 0 -max ${_lastFrame}
271    $itk_component(play) enable
272
273    fixSize
274}
275
276# ----------------------------------------------------------------------
277# loadcb - load callback
278# ----------------------------------------------------------------------
279itcl::body Rappture::VideoPreview::loadcb {args} {
280    video stop
281    Rappture::filexfer::upload {piv tool} {id label desc} [itcl::code $this Upload]
282}
283
284# ----------------------------------------------------------------------
285# Upload -
286# ----------------------------------------------------------------------
287itcl::body Rappture::VideoPreview::Upload {args} {
288    array set data $args
289    video stop
290
291    if {[info exists data(error)]} {
292        Rappture::Tooltip::cue $itk::component(main) $data(error)
293        puts stderr $data(error)
294    }
295
296    if {[info exists data(path)] && [info exists data(data)]} {
297        Rappture::Tooltip::cue hide  ;# take down note about the popup window
298
299        # load data
300        load "data" $data(data)
301    }
302
303}
304
305# ----------------------------------------------------------------------
306# USAGE: _fixValue ?<name1> <name2> <op>?
307#
308# Invoked automatically whenever the -variable associated with this
309# widget is modified.  Copies the value to the current settings for
310# the widget.
311# ----------------------------------------------------------------------
312itcl::body Rappture::VideoPreview::_fixValue {args} {
313    if {"" == $itk_option(-variable)} {
314        return
315    }
316    upvar #0 $itk_option(-variable) var
317    if {[file readable $var]} {
318        # load and start playing the video
319        set _path $var
320        load file ${_path}
321        set _settings($this-play) 1
322        video play
323    }
324}
325
326# ----------------------------------------------------------------------
327# fixSize
328# ----------------------------------------------------------------------
329itcl::body Rappture::VideoPreview::fixSize {} {
330
331    if {[string compare "" ${_movie}] == 0} {
332        return
333    }
334
335    set cw [winfo width $itk_component(main)]
336    set ch [winfo height $itk_component(main)]
337
338    # FIXME: right now we only deal with 16:9 ratio videos
339    # always keep the aspect ratio correct
340    set _width [expr int(int($cw/16.0)*16.0)]
341    set _height [expr int(${_width}/(16.0/9.0))]
342    if {${_height} > $ch} {
343        # if height is limiting us, shrink some more
344        set _height [expr int(int($ch/9.0)*9.0)]
345        set _width [expr int(${_height}*(16.0/9.0))]
346    }
347
348    # get an image with the new size
349    ${_imh} blank
350    ${_imh} put [${_movie} get image ${_width} ${_height}]
351
352    # make the canvas fit the image
353    $itk_component(main) configure -width ${_width} -height ${_height}
354}
355
356# ----------------------------------------------------------------------
357# video - play, stop, rewind, fastforward the video
358# ----------------------------------------------------------------------
359itcl::body Rappture::VideoPreview::video { args } {
360    set option [lindex $args 0]
361    switch -- $option {
362        "play" {
363            if {$_settings($this-play) == 1} {
364                eventually play
365            } else {
366                # pause/stop
367                after cancel $_id
368                set _pendings(play) 0
369                set _settings($this-play) 0
370            }
371        }
372        "seek" {
373            Seek [lreplace $args 0 0]
374        }
375        "stop" {
376            after cancel $_id
377            set _settings($this-play) 0
378        }
379        "update" {
380            # eventually seek [expr round($_settings($this-framenum))]
381            Seek [expr round($_settings($this-framenum))]
382        }
383        default {
384            error "bad option \"$option\": should be play, stop, toggle, position, or reset."
385        }
386    }
387}
388
389# ----------------------------------------------------------------------
390# query - query things about the video
391#
392#   dimensions  - returns width and height as a list
393#   frames      - number of frames in video (last frame + 1)
394#   framenum    - current position
395# ----------------------------------------------------------------------
396itcl::body Rappture::VideoPreview::query { type } {
397    set ret ""
398    switch -- $type {
399        "dimensions" {
400            set ret [${_movie} size]
401        }
402        "frames" {
403            set ret [expr [${_movie} get position end] + 1]
404        }
405        "framenum" {
406            set ret [${_movie} get position cur]
407        }
408        default {
409            error "bad type \"$type\": should be dimensions, frames, framenum."
410        }
411    }
412    return $ret
413}
414
415# ----------------------------------------------------------------------
416# Play - get the next video frame
417# ----------------------------------------------------------------------
418itcl::body Rappture::VideoPreview::Play {} {
419
420    set cur ${_nextframe}
421
422    # time how long it takes to retrieve the next frame
423    set _ofrd [time {
424        # use seek instead of next fxn incase the ${_nextframe} is
425        # not the current frame+1. this happens when we skip frames
426        # because the underlying c lib is too slow at reading.
427        $_movie seek $cur
428        $_imh put [$_movie get image ${_width} ${_height}]
429    } 1]
430    regexp {(\d+\.?\d*) microseconds per iteration} ${_ofrd} match _ofrd
431    set _ofrd [expr {round(${_ofrd}/1000)}]
432
433    # calculate the delay we shoud see
434    # between frames being placed on screen
435    # taking into account the cost of retrieving the frame
436    set _delay [expr {${_mspf}-${_ofrd}}]
437    if {0 > ${_delay}} {
438        set _delay 0
439    }
440
441    set cur [$_movie get position cur]
442
443    # update the dial and framenum widgets
444    set _settings($this-framenum) $cur
445
446    # no play cmds pending
447    set _pendings(play) 0
448
449    # schedule the next frame to be displayed
450    if {$cur < ${_lastFrame}} {
451        set _id [after ${_delay} [itcl::code $this eventually play]]
452    } else {
453        video stop
454    }
455
456    event generate $itk_component(hull) <<Frame>>
457}
458
459
460# ----------------------------------------------------------------------
461# Seek - go to a frame in the video
462#   Seek +5
463#   Seek -5
464#   Seek 35
465# ----------------------------------------------------------------------
466itcl::body Rappture::VideoPreview::Seek {args} {
467    set val [lindex $args 0]
468    if {"" == $val} {
469        error "bad value: \"$val\": should be \"seek value\""
470    }
471    set cur [$_movie get position cur]
472    if {[string compare $cur $val] == 0} {
473        # already at the frame to seek to
474        return
475    }
476    ${_movie} seek $val
477    ${_imh} put [${_movie} get image ${_width} ${_height}]
478
479    # update the dial and framenum widgets
480    set _settings($this-framenum) [$_movie get position cur]
481    event generate $itk_component(main) <<Frame>>
482
483}
484
485
486# ----------------------------------------------------------------------
487# eventually -
488#   seek
489#   play
490# ----------------------------------------------------------------------
491itcl::body Rappture::VideoPreview::eventually {args} {
492    set option [lindex $args 0]
493    switch -- $option {
494        "seek" {
495            if {$_pendings(seek) == 0} {
496                # no seek pending, schedule one
497                set $_pendings(seek) 1
498                after idle [itcl::code $this Seek [lindex $args 1]]
499            } else {
500                # there is a seek pending, update its seek value
501            }
502        }
503        "play" {
504            if {0 == $_pendings(play)} {
505                # no play pending schedule one
506                set _pendings(play) 1
507                set _nextframe [expr {[$_movie get position cur] + 1}]
508                after idle [itcl::code $this Play]
509            } else {
510                # there is a play pending, update its frame value
511                incr _nextframe
512            }
513        }
514        default {
515        }
516    }
517}
518
519# ----------------------------------------------------------------------
520# CONFIGURE: -variable
521# ----------------------------------------------------------------------
522itcl::configbody Rappture::VideoPreview::variable {
523    if {"" != $_variable} {
524        upvar #0 $_variable var
525        trace remove variable var write [itcl::code $this _fixValue]
526    }
527
528    set _variable $itk_option(-variable)
529
530    if {"" != $_variable} {
531        upvar #0 $_variable var
532        trace add variable var write [itcl::code $this _fixValue]
533
534        # sync to the current value of this variable
535        if {[info exists var]} {
536            _fixValue
537        }
538    }
539}
540
541# ----------------------------------------------------------------------
542# OPTION: -width
543# ----------------------------------------------------------------------
544itcl::configbody Rappture::VideoPreview::width {
545    # $_dispatcher event -idle !fixsize
546    if {[string is integer $itk_option(-width)] == 0} {
547        error "bad value: \"$itk_option(-width)\": width should be an integer"
548    }
549    set _width $itk_option(-width)
550    after idle [itcl::code $this fixSize]
551}
552
553# ----------------------------------------------------------------------
554# OPTION: -height
555# ----------------------------------------------------------------------
556itcl::configbody Rappture::VideoPreview::height {
557    # $_dispatcher event -idle !fixsize
558    if {[string is integer $itk_option(-height)] == 0} {
559        error "bad value: \"$itk_option(-height)\": height should be an integer"
560    }
561    set _height $itk_option(-height)
562    after idle [itcl::code $this fixSize]
563}
Note: See TracBrowser for help on using the repository browser.