source: branches/blt4/gui/scripts/videoscreen.tcl @ 1932

Last change on this file since 1932 was 1932, checked in by gah, 14 years ago
File size: 16.8 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: video - viewing movies
3#
4# ======================================================================
5#  AUTHOR:  Michael McLennan, Purdue University
6#  Copyright (c) 2004-2005  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*cursor crosshair widgetDefault
20option add *Video.height 300 widgetDefault
21option add *Video.foreground black widgetDefault
22option add *Video.controlBackground gray widgetDefault
23option add *Video.controlDarkBackground #999999 widgetDefault
24option add *Video.plotBackground black widgetDefault
25option add *Video.plotForeground white widgetDefault
26option add *Video.plotOutline gray widgetDefault
27option add *Video.font \
28    -*-helvetica-medium-r-normal-*-12-* widgetDefault
29
30itcl::class Rappture::VideoScreen {
31    inherit itk::Widget
32
33    itk_option define -plotforeground plotForeground Foreground ""
34    itk_option define -plotbackground plotBackground Background ""
35    itk_option define -plotoutline plotOutline PlotOutline ""
36    itk_option define -width width Width -1
37    itk_option define -height height Height -1
38
39    constructor { args } {
40        # defined below
41    }
42    destructor {
43        # defined below
44    }
45
46    public method load {type data}
47    public method loadcb {args}
48    public method video {args}
49    public method query {type}
50
51    protected method Play {}
52    protected method Seek {n}
53    protected method fixSize {}
54    protected method Upload {args}
55
56
57    private common   _settings
58
59    private variable _width -1      ;# start x for rubberbanding
60    private variable _height -1     ;# start x for rubberbanding
61    private variable _movie ""      ;# movie we grab images from
62    private variable _lastFrame 0   ;# last frame in the movie
63    private variable _imh ""        ;# current image being displayed
64    private variable _id ""         ;# id of the next play command from after
65    private variable _framerate 30  ;# video frame rate
66    private variable _mspf  7       ;# milliseconds per frame wait time
67    private variable _waiting 0     ;# number of frames behind we are
68}
69
70itk::usual VideoScreen {
71    keep -background -foreground -cursor -font
72    keep -plotbackground -plotforeground
73}
74
75# ----------------------------------------------------------------------
76# CONSTRUCTOR
77# ----------------------------------------------------------------------
78itcl::body Rappture::VideoScreen::constructor {args} {
79
80    array set _settings [subst {
81        $this-currenttime       0
82        $this-framenum          0
83        $this-loop              0
84        $this-play              0
85        $this-speed             1
86    }]
87
88    # Create flow controls...
89
90    itk_component add main {
91        canvas $itk_interior.main \
92            -background black
93    } {
94        usual
95        rename -background -controlbackground controlBackground Background
96    }
97
98    # pack $itk_component(main) -side top -expand yes -fill both
99    bind $itk_component(main) <Configure> [itcl::code $this fixSize]
100
101    # setup movie controls
102    itk_component add moviecontrols {
103        frame $itk_interior.moviecontrols
104    } {
105        usual
106        rename -background -controlbackground controlBackground Background
107    }
108
109    # Rewind
110    itk_component add rewind {
111        button $itk_component(moviecontrols).rewind \
112            -borderwidth 1 -padx 1 -pady 1 \
113            -image [Rappture::icon video-rewind] \
114            -command [itcl::code $this video seek 0]
115    } {
116        usual
117        ignore -borderwidth
118        rename -highlightbackground -controlbackground controlBackground \
119            Background
120    }
121    Rappture::Tooltip::for $itk_component(rewind) \
122        "Rewind movie"
123
124    # Seek back
125    itk_component add seekback {
126        button $itk_component(moviecontrols).seekback \
127            -borderwidth 1 -padx 1 -pady 1 \
128            -image [Rappture::icon flow-rewind] \
129            -command [itcl::code $this video seek -1]
130    } {
131        usual
132        ignore -borderwidth
133        rename -highlightbackground -controlbackground controlBackground \
134            Background
135    }
136    Rappture::Tooltip::for $itk_component(rewind) \
137        "Seek backwards 1 frame"
138
139    # Play
140    itk_component add play {
141        Rappture::PushButton $itk_component(moviecontrols).play \
142            -onimage [Rappture::icon flow-pause] \
143            -offimage [Rappture::icon flow-play] \
144            -variable [itcl::scope _settings($this-play)] \
145            -command [itcl::code $this video play]
146    }
147    set fg [option get $itk_component(hull) font Font]
148    Rappture::Tooltip::for $itk_component(play) \
149        "Play/Pause movie"
150
151    # Seek forward
152    itk_component add seekforward {
153        button $itk_component(moviecontrols).seekforward \
154            -borderwidth 1 -padx 1 -pady 1 \
155            -image [Rappture::icon flow-forward] \
156            -command [itcl::code $this video seek +1]
157    } {
158        usual
159        ignore -borderwidth
160        rename -highlightbackground -controlbackground controlBackground \
161            Background
162    }
163    Rappture::Tooltip::for $itk_component(seekforward) \
164        "Seek forward 1 frame"
165
166    # Loop
167    itk_component add loop {
168        Rappture::PushButton $itk_component(moviecontrols).loop \
169            -onimage [Rappture::icon flow-loop] \
170            -offimage [Rappture::icon flow-loop] \
171            -variable [itcl::scope _settings($this-loop)]
172    }
173    Rappture::Tooltip::for $itk_component(loop) \
174        "Play continuously between marked sections"
175
176    itk_component add dial {
177        Rappture::Videodial $itk_component(moviecontrols).dial \
178            -length 10 -valuewidth 0 -valuepadding 0 -padding 6 \
179            -linecolor "" -activelinecolor "" \
180            -min 0 -max 1 \
181            -minortick 1 -majortick 5 \
182            -variable [itcl::scope _settings($this-currenttime)] \
183            -knobimage [Rappture::icon knob2] -knobposition center@middle
184    } {
185        usual
186        ignore -dialprogresscolor
187        rename -background -controlbackground controlBackground Background
188    }
189    $itk_component(dial) current 0
190    bind $itk_component(dial) <<Value>> \
191        [itcl::code $this video seek [expr round($_settings($this-currenttime))]]
192
193    itk_component add framenumlabel {
194        label $itk_component(moviecontrols).framenuml -text "Frame:" -font $fg \
195            -highlightthickness 0
196    } {
197        usual
198        ignore -highlightthickness
199        rename -background -controlbackground controlBackground Background
200    }
201
202    # Current Frame Number
203    #set ffont "arial 9"
204    #set fwidth [calcLabelWidth $ffont]
205    itk_component add framenum {
206        label $itk_component(moviecontrols).framenum \
207            -background white -font "arial 9" \
208            -textvariable [itcl::scope _settings($this-framenum)]
209    } {
210        usual
211        ignore -highlightthickness
212        rename -background -controlbackground controlBackground Background
213    }
214    #$itk_component(framenum) value 1
215    #bind $itk_component(framenum) <<Value>> \
216    #    [itcl::code $this video seek -framenum]
217    Rappture::Tooltip::for $itk_component(framenum) \
218        "Current frame number"
219
220    itk_component add speedlabel {
221        label $itk_component(moviecontrols).speedl -text "Speed:" -font $fg \
222            -highlightthickness 0
223    } {
224        usual
225        ignore -highlightthickness
226        rename -background -controlbackground controlBackground Background
227    }
228
229    # Speed
230    itk_component add speed {
231        Rappture::Flowspeed $itk_component(moviecontrols).speed \
232            -min 1 -max 10 -width 3 -font "arial 9"
233    } {
234        usual
235        ignore -highlightthickness
236        rename -background -controlbackground controlBackground Background
237    }
238    Rappture::Tooltip::for $itk_component(speed) \
239        "Change speed of movie"
240
241    $itk_component(speed) value 1
242    bind $itk_component(speed) <<Value>> [itcl::code $this video speed]
243
244
245    blt::table $itk_component(moviecontrols) \
246        0,0 $itk_component(rewind) -padx {3 0} \
247        0,1 $itk_component(seekback) -padx {2 0} \
248        0,2 $itk_component(play) -padx {2 0} \
249        0,3 $itk_component(seekforward) -padx { 2 0} \
250        0,4 $itk_component(loop) -padx {2 0} \
251        0,5 $itk_component(dial) -fill x -padx {2 0 } \
252        0,6 $itk_component(framenumlabel) -padx {2 0} \
253        0,7 $itk_component(framenum) -padx { 0 0} \
254        0,8 $itk_component(speed) -padx {2 3}
255
256    blt::table configure $itk_component(moviecontrols) c* -resize none
257    blt::table configure $itk_component(moviecontrols) c5 -resize both
258    blt::table configure $itk_component(moviecontrols) r0 -pady 1
259
260
261    blt::table $itk_interior \
262        0,0 $itk_component(main) -fill both \
263        1,0 $itk_component(moviecontrols) -fill x
264    blt::table configure $itk_interior c* -resize both
265    blt::table configure $itk_interior r0 -resize both
266    blt::table configure $itk_interior r1 -resize none
267
268    eval itk_initialize $args
269}
270
271# ----------------------------------------------------------------------
272# DESTRUCTOR
273# ----------------------------------------------------------------------
274itcl::body Rappture::VideoScreen::destructor {} {
275    array unset _settings $this-*
276}
277
278# ----------------------------------------------------------------------
279# load - load a video file
280#   type - type of data, "data" or "file"
281#   data - what to load.
282#       if type == "data", data is treated like binary data
283#       if type == "file", data is treated like the name of a file
284#           and is opened and then loaded.
285# ----------------------------------------------------------------------
286itcl::body Rappture::VideoScreen::load {type data} {
287
288    # open the file
289
290    set fname ""
291    switch $type {
292        "data" {
293            set fname "/tmp/tmpVV[pid].video"
294            set fid [open $fname "w"]
295            fconfigure $fid -translation binary -encoding binary
296            puts $fid $data
297            close $fid
298            set type "file"
299            set data $fname
300        }
301        "file" {
302            # do nothing
303        }
304        default {
305            error "bad value: \"$type\": should be \"load \[data|file\] <data>\""
306        }
307    }
308
309    set _movie [Rappture::Video $type $data]
310    file delete $fname
311    set _framerate [${_movie} get framerate]
312    set _mspf [expr round(((1.0/${_framerate})*1000)/pow(2,$_settings($this-speed)-1))]
313    puts "framerate = ${_framerate}"
314    puts "mspf = ${_mspf}"
315
316    ${_movie} seek 0
317
318    # setup the image display
319
320    set _imh [image create photo]
321    foreach {w h} [query dimensions] break
322    if {${_width} == -1} {
323        set _width $w
324    }
325    if {${_height} == -1} {
326        set _height $h
327    }
328    $itk_component(main) create image 0 0 -anchor nw -image $_imh
329
330    set _lastFrame [$_movie get position end]
331
332    # update the dial with video information
333    $itk_component(dial) configure -min 0 -max ${_lastFrame}
334
335    fixSize
336}
337
338# ----------------------------------------------------------------------
339# loadcb - load callback
340# ----------------------------------------------------------------------
341itcl::body Rappture::VideoScreen::loadcb {args} {
342
343    Rappture::filexfer::upload {piv tool} {id label desc} [itcl::code $this Upload]
344
345    #uplevel 1 [list $args]
346}
347
348# ----------------------------------------------------------------------
349# Upload -
350# ----------------------------------------------------------------------
351itcl::body Rappture::VideoScreen::Upload {args} {
352    array set data $args
353
354    if {[info exists data(error)]} {
355        Rappture::Tooltip::cue $itk::component(main) $data(error)
356        puts $data(error)
357    }
358
359    if {[info exists data(path)] && [info exists data(data)]} {
360        Rappture::Tooltip::cue hide  ;# take down note about the popup window
361
362        # load data
363        load "data" $data(data)
364    }
365
366}
367
368
369# ----------------------------------------------------------------------
370# fixSize
371# ----------------------------------------------------------------------
372itcl::body Rappture::VideoScreen::fixSize {} {
373
374    if {[string compare "" ${_movie}] == 0} {
375        return
376    }
377
378    set _width [winfo width $itk_component(main)]
379    set _height [winfo height $itk_component(main)]
380
381    # get an image with the new size
382    ${_imh} put [${_movie} get image ${_width} ${_height}]
383
384    # fix the dimesions of the canvas
385    #$itk_component(main) configure -width ${_width} -height ${_height}
386
387    $itk_component(main) configure -scrollregion [$itk_component(main) bbox all]
388}
389
390# ----------------------------------------------------------------------
391# video - play, stop, rewind, fastforward the video
392# ----------------------------------------------------------------------
393itcl::body Rappture::VideoScreen::video { args } {
394    set option [lindex $args 0]
395    switch -- $option {
396        "play" {
397            if {$_settings($this-play) == 1} {
398                # disable seek while playing
399                bind $itk_component(dial) <<Value>> ""
400                Play
401            } else {
402                # pause/stop
403                after cancel $_id
404                set _settings($this-play) 0
405                # enable seek while paused
406                bind $itk_component(dial) <<Value>> \
407                    [itcl::code $this video seek [expr round($_settings($this-currenttime))]]
408            }
409        }
410        "seek" {
411            Seek [lreplace $args 0 0]
412        }
413        "stop" {
414            after cancel $_id
415            set _settings($this-play) 0
416        }
417        "speed" {
418            set _mspf [expr round(((1.0/${_framerate})*1000)/pow(2,$_settings($this-speed)-1))]
419            puts "_mspf = ${_mspf}"
420        }
421        default {
422            error "bad option \"$option\": should be play, stop, toggle, position, or reset."
423        }
424    }
425}
426
427# ----------------------------------------------------------------------
428# query - query things about the video
429#
430#   dimensions  - returns width and height as a list
431#   frames      - number of frames in video (last frame + 1)
432#   framenum    - current position
433# ----------------------------------------------------------------------
434itcl::body Rappture::VideoScreen::query { type } {
435    set ret ""
436    switch -- $type {
437        "dimensions" {
438            set ret [${_movie} size]
439        }
440        "frames" {
441            set ret [expr [${_movie} get position end] + 1]
442        }
443        "framenum" {
444            set ret [${_movie} get position cur]
445        }
446        default {
447            error "bad type \"$type\": should be dimensions, frames, framenum."
448        }
449    }
450    return $ret
451}
452
453# ----------------------------------------------------------------------
454# Play - get the next video frame
455# ----------------------------------------------------------------------
456itcl::body Rappture::VideoScreen::Play {} {
457
458
459    # display the next frame
460    $_movie next
461    $_imh put [$_movie get image ${_width} ${_height}]
462    set cur [$_movie get position cur]
463
464    event generate $itk_component(hull) <<Frame>>
465
466    # update the dial and framenum widgets
467    $itk_component(dial) current $cur
468    set _settings($this-framenum) $cur
469
470    if {[expr $cur%100] == 0} {
471        puts "after: [after info]"
472        puts "id = ${_id}"
473    }
474
475    # schedule the next frame to be displayed
476    if {$cur < ${_lastFrame}} {
477        set _id [after ${_mspf} [itcl::code $this Play]]
478    }
479}
480
481
482# ----------------------------------------------------------------------
483# Seek - go to a frame in the video frame
484#   Seek +5
485#   Seek -5
486#   Seek 35
487# ----------------------------------------------------------------------
488itcl::body Rappture::VideoScreen::Seek {args} {
489    set val [lindex $args 0]
490    if {"" == $val} {
491        error "bad value: \"$val\": should be \"seek value\""
492    }
493    ${_movie} seek $val
494    ${_imh} put [${_movie} get image ${_width} ${_height}]
495}
496
497# ----------------------------------------------------------------------
498# OPTION: -width
499# ----------------------------------------------------------------------
500itcl::configbody Rappture::VideoScreen::width {
501    # $_dispatcher event -idle !fixsize
502    if {[string is integer $itk_option(-width)] == 0} {
503        error "bad value: \"$itk_option(-width)\": width should be an integer"
504    }
505    set ${_width} $itk_option(-width)
506    after idle [itcl::code $this fixSize]
507}
508
509# ----------------------------------------------------------------------
510# OPTION: -height
511# ----------------------------------------------------------------------
512itcl::configbody Rappture::VideoScreen::height {
513    # $_dispatcher event -idle !fixsize
514    if {[string is integer $itk_option(-height)] == 0} {
515        error "bad value: \"$itk_option(-height)\": height should be an integer"
516    }
517    set ${_height} $itk_option(-height)
518    after idle [itcl::code $this fixSize]
519}
Note: See TracBrowser for help on using the repository browser.