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

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

adding select function to mimic a button-1 press on a video from the video chooser.
File size: 17.6 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} 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    if {![winfo ismapped $itk_component(hull)]} {
336        return
337    }
338
339    set cw [winfo width $itk_component(main)]
340    set ch [winfo height $itk_component(main)]
341
342    # FIXME: right now we only deal with 16:9 ratio videos
343    # always keep the aspect ratio correct
344    set _width [expr int(int($cw/16.0)*16.0)]
345    set _height [expr int(${_width}/(16.0/9.0))]
346    if {${_height} > $ch} {
347        # if height is limiting us, shrink some more
348        set _height [expr int(int($ch/9.0)*9.0)]
349        set _width [expr int(${_height}*(16.0/9.0))]
350    }
351
352    # get an image with the new size
353    ${_imh} blank
354    ${_imh} put [${_movie} get image ${_width} ${_height}]
355
356    # make the canvas fit the image
357    $itk_component(main) configure -width ${_width} -height ${_height}
358}
359
360# ----------------------------------------------------------------------
361# video - play, stop, rewind, fastforward the video
362# ----------------------------------------------------------------------
363itcl::body Rappture::VideoPreview::video { args } {
364    set option [lindex $args 0]
365    switch -- $option {
366        "play" {
367            if {$_settings($this-play) == 1} {
368                eventually play
369            } else {
370                # pause/stop
371                after cancel $_id
372                set _pendings(play) 0
373                set _settings($this-play) 0
374            }
375        }
376        "seek" {
377            Seek [lreplace $args 0 0]
378        }
379        "stop" {
380            after cancel $_id
381            set _settings($this-play) 0
382        }
383        "update" {
384            # eventually seek [expr round($_settings($this-framenum))]
385            Seek [expr round($_settings($this-framenum))]
386        }
387        default {
388            error "bad option \"$option\": should be play, stop, toggle, position, or reset."
389        }
390    }
391}
392
393# ----------------------------------------------------------------------
394# query - query things about the video
395#
396#   dimensions  - returns width and height as a list
397#   frames      - number of frames in video (last frame + 1)
398#   framenum    - current position
399# ----------------------------------------------------------------------
400itcl::body Rappture::VideoPreview::query { type } {
401    set ret ""
402    switch -- $type {
403        "dimensions" {
404            set ret [${_movie} size]
405        }
406        "frames" {
407            set ret [expr [${_movie} get position end] + 1]
408        }
409        "framenum" {
410            set ret [${_movie} get position cur]
411        }
412        default {
413            error "bad type \"$type\": should be dimensions, frames, framenum."
414        }
415    }
416    return $ret
417}
418
419# ----------------------------------------------------------------------
420# Play - get the next video frame
421# ----------------------------------------------------------------------
422itcl::body Rappture::VideoPreview::Play {} {
423
424    set cur ${_nextframe}
425
426    # time how long it takes to retrieve the next frame
427    set _ofrd [time {
428        # use seek instead of next fxn incase the ${_nextframe} is
429        # not the current frame+1. this happens when we skip frames
430        # because the underlying c lib is too slow at reading.
431        $_movie seek $cur
432        $_imh put [${_movie} get image ${_width} ${_height}]
433    } 1]
434    regexp {(\d+\.?\d*) microseconds per iteration} ${_ofrd} match _ofrd
435    set _ofrd [expr {round(${_ofrd}/1000)}]
436
437    # calculate the delay we shoud see
438    # between frames being placed on screen
439    # taking into account the cost of retrieving the frame
440    set _delay [expr {${_mspf}-${_ofrd}}]
441    if {0 > ${_delay}} {
442        set _delay 0
443    }
444
445    set cur [${_movie} get position cur]
446
447    # update the dial and framenum widgets
448    set _settings($this-framenum) $cur
449
450    # no play cmds pending
451    set _pendings(play) 0
452
453    # schedule the next frame to be displayed
454    if {$cur < ${_lastFrame}} {
455        set _id [after ${_delay} [itcl::code $this eventually play]]
456    } else {
457        video stop
458    }
459
460    event generate $itk_component(hull) <<Frame>>
461}
462
463
464# ----------------------------------------------------------------------
465# Seek - go to a frame in the video
466#   Seek +5
467#   Seek -5
468#   Seek 35
469# ----------------------------------------------------------------------
470itcl::body Rappture::VideoPreview::Seek {args} {
471    set val [lindex $args 0]
472    if {"" == $val} {
473        error "bad value: \"$val\": should be \"seek value\""
474    }
475    set cur [${_movie} get position cur]
476    if {[string compare $cur $val] == 0} {
477        # already at the frame to seek to
478        return
479    }
480    ${_movie} seek $val
481    ${_imh} put [${_movie} get image ${_width} ${_height}]
482
483    # update the dial and framenum widgets
484    set _settings($this-framenum) [${_movie} get position cur]
485    event generate $itk_component(main) <<Frame>>
486
487}
488
489
490# ----------------------------------------------------------------------
491# eventually -
492#   seek
493#   play
494# ----------------------------------------------------------------------
495itcl::body Rappture::VideoPreview::eventually {args} {
496    set option [lindex $args 0]
497    switch -- $option {
498        "seek" {
499            if {$_pendings(seek) == 0} {
500                # no seek pending, schedule one
501                set $_pendings(seek) 1
502                after idle [itcl::code $this Seek [lindex $args 1]]
503            } else {
504                # there is a seek pending, update its seek value
505            }
506        }
507        "play" {
508            if {0 == $_pendings(play)} {
509                # no play pending schedule one
510                set _pendings(play) 1
511                set _nextframe [expr {[${_movie} get position cur] + 1}]
512                after idle [itcl::code $this Play]
513            } else {
514                # there is a play pending, update its frame value
515                incr _nextframe
516            }
517        }
518        default {
519        }
520    }
521}
522
523# ----------------------------------------------------------------------
524# CONFIGURE: -variable
525# ----------------------------------------------------------------------
526itcl::configbody Rappture::VideoPreview::variable {
527    if {"" != $_variable} {
528        upvar #0 $_variable var
529        trace remove variable var write [itcl::code $this _fixValue]
530    }
531
532    set _variable $itk_option(-variable)
533
534    if {"" != $_variable} {
535        upvar #0 $_variable var
536        trace add variable var write [itcl::code $this _fixValue]
537
538        # sync to the current value of this variable
539        if {[info exists var]} {
540            _fixValue
541        }
542    }
543}
544
545# ----------------------------------------------------------------------
546# OPTION: -width
547# ----------------------------------------------------------------------
548itcl::configbody Rappture::VideoPreview::width {
549    # $_dispatcher event -idle !fixsize
550    if {[string is integer $itk_option(-width)] == 0} {
551        error "bad value: \"$itk_option(-width)\": width should be an integer"
552    }
553    set _width $itk_option(-width)
554    after idle [itcl::code $this fixSize]
555}
556
557# ----------------------------------------------------------------------
558# OPTION: -height
559# ----------------------------------------------------------------------
560itcl::configbody Rappture::VideoPreview::height {
561    # $_dispatcher event -idle !fixsize
562    if {[string is integer $itk_option(-height)] == 0} {
563        error "bad value: \"$itk_option(-height)\": height should be an integer"
564    }
565    set _height $itk_option(-height)
566    after idle [itcl::code $this fixSize]
567}
Note: See TracBrowser for help on using the repository browser.