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

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

adding aspect ratio calculations.
disable analyze button when no movie has been choosen in piv
rename some functions
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} 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.