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

Last change on this file since 3177 was 3177, checked in by mmc, 12 years ago

Updated all of the copyright notices to reference the transfer to
the new HUBzero Foundation, LLC.
File size: 17.6 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: videopreview - previewing movies
3#
4# ======================================================================
5#  AUTHOR:  Derrick Kearney, Purdue University
6#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
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.