source: branches/blt4/gui/scripts/videoviewer.tcl @ 1919

Last change on this file since 1919 was 1919, checked in by gah, 14 years ago
File size: 34.3 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: videoviewer - 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 *VideoViewer.width 5i widgetDefault
19option add *VideoViewer*cursor crosshair widgetDefault
20option add *VideoViewer.height 4i widgetDefault
21option add *VideoViewer.foreground black widgetDefault
22option add *VideoViewer.controlBackground gray widgetDefault
23option add *VideoViewer.controlDarkBackground #999999 widgetDefault
24option add *VideoViewer.plotBackground black widgetDefault
25option add *VideoViewer.plotForeground white widgetDefault
26option add *VideoViewer.plotOutline gray widgetDefault
27option add *VideoViewer.font \
28    -*-helvetica-medium-r-normal-*-12-* widgetDefault
29
30itcl::class Rappture::VideoViewer {
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
37    constructor { args } {
38        # defined below
39    }
40    destructor {
41        # defined below
42    }
43
44    public method load {filename}
45    public method video {args}
46
47    protected method togglePtrBind {pbvar}
48    protected method togglePtrCtrl {pbvar}
49    protected method whatPtrCtrl {}
50
51    protected method Play {}
52    protected method Seek {n}
53    protected method Rubberband {status win x y}
54    protected method Distance {status win x y}
55    protected method Measure {status win x y}
56    protected method Particle {status win x y}
57    protected method Trajectory {args}
58    protected method updateMeasurements {}
59    protected method calculateTrajectory {args}
60
61    private common   _settings
62
63    private variable _width 0
64    private variable _height 0
65    private variable _x0 0          ;# start x for rubberbanding
66    private variable _y0 0          ;# start y for rubberbanding
67    private variable _units "m"
68    private variable _movie ""      ;# movie we grab images from
69    private variable _lastFrame 0   ;# last frame in the movie
70    private variable _imh ""        ;# current image being displayed
71    private variable _id ""         ;# id of the next play command from after
72    private variable _pbvlist ""    ;# list of push button variables
73    private variable _px2dist 0     ;# conversion for screen px to distance
74    private variable _measCnt 0     ;# count of the number measure lines
75    private variable _measTags ""   ;# list of measure line tags on canvas
76    private variable _particles ""  ;# list of particles
77    private variable _pcnt -1       ;# particle count
78    private variable _framerate 30  ;# video frame rate
79    private variable _mspf 20       ;# milliseconds per frame wait time
80    private variable _waiting 0     ;# number of frames behind we are
81}
82
83itk::usual VideoViewer {
84    keep -background -foreground -cursor -font
85    keep -plotbackground -plotforeground
86}
87
88# ----------------------------------------------------------------------
89# CONSTRUCTOR
90# ----------------------------------------------------------------------
91itcl::body Rappture::VideoViewer::constructor {args} {
92
93    array set _settings [subst {
94        $this-arrows            0
95        $this-currenttime       0
96        $this-framenum          0
97        $this-duration          1:00
98        $this-loop              0
99        $this-play              0
100        $this-speed             500
101        $this-step              0
102    }]
103
104    # Create flow controls...
105
106    itk_component add main {
107        canvas $itk_interior.main \
108            -background black
109    } {
110        usual
111        rename -background -controlbackground controlBackground Background
112    }
113
114    itk_component add pointercontrols {
115        frame $itk_interior.pointercontrols
116    } {
117        usual
118        rename -background -controlbackground controlBackground Background
119    }
120
121
122    itk_component add moviecontrols {
123        frame $itk_interior.moviecontrols
124    } {
125        usual
126        rename -background -controlbackground controlBackground Background
127    }
128
129    pack forget $itk_component(main)
130    blt::table $itk_interior \
131        0,0 $itk_component(pointercontrols) -fill x \
132        1,0 $itk_component(main) -fill both \
133        2,0 $itk_component(moviecontrols) -fill x
134    # why do i have to explicitly say r0 and r2 instead of r*
135    blt::table configure $itk_interior r0 -resize none
136    blt::table configure $itk_interior r2 -resize none
137    blt::table configure $itk_interior c0 -padx 1
138
139
140    # setup pointer controls
141
142    set imagesDir [file join $RapptureGUI::library scripts images]
143
144    # ==== rectangle select tool ====
145    set rectImg [image create photo -file [file join $imagesDir "rect_dashed_black.png"]]
146    itk_component add rectangle {
147        Rappture::PushButton $itk_component(pointercontrols).rectanglepb \
148            -onimage $rectImg \
149            -offimage $rectImg \
150            -command [itcl::code $this togglePtrCtrl rectPbVar] \
151            -variable rectPbVar
152    } {
153        usual
154    }
155    Rappture::Tooltip::for $itk_component(rectangle) \
156        "rectangle select tool"
157
158    lappend _pbvlist rectPbVar
159
160    # ==== distance specify tool ====
161    set distImg [image create photo -file [file join $imagesDir "line_darrow_red.png"]]
162    itk_component add distance {
163        Rappture::PushButton $itk_component(pointercontrols).distancepb \
164            -onimage $distImg \
165            -offimage $distImg \
166            -command [itcl::code $this togglePtrCtrl distPbVar] \
167            -variable distPbVar
168    } {
169        usual
170    }
171    Rappture::Tooltip::for $itk_component(distance) \
172        "Specify the distance of a structure"
173
174    lappend _pbvlist distPbVar
175
176
177
178    # ==== measuring tool ====
179    set measImg [image create photo -file [file join $imagesDir "line_darrow_green.png"]]
180    itk_component add measure {
181        Rappture::PushButton $itk_component(pointercontrols).measurepb \
182            -onimage $measImg \
183            -offimage $measImg \
184            -command [itcl::code $this togglePtrCtrl measPbVar] \
185            -variable measPbVar
186    } {
187        usual
188    }
189    Rappture::Tooltip::for $itk_component(measure) \
190        "Measure the distance of a structure"
191
192    lappend _pbvlist measPbVar
193
194
195
196    # ==== particle mark tool ====
197    set particleImg [image create photo -file [file join $imagesDir "volume-on.gif"]]
198    itk_component add particle {
199        Rappture::PushButton $itk_component(pointercontrols).particlepb \
200            -onimage $particleImg \
201            -offimage $particleImg \
202            -command [itcl::code $this togglePtrCtrl partPbVar] \
203            -variable partPbVar
204    } {
205        usual
206    }
207    Rappture::Tooltip::for $itk_component(particle) \
208        "Mark the location of a particle to follow"
209
210    lappend _pbvlist partPbVar
211
212    blt::table $itk_component(pointercontrols) \
213        0,0 $itk_component(rectangle) -pady {3 0} \
214        0,1 $itk_component(distance) -pady {3 0} \
215        0,2 $itk_component(measure) -pady {3 0} \
216        0,3 $itk_component(particle) -pady {3 0}
217
218    blt::table configure $itk_component(pointercontrols) c* -resize none
219    blt::table configure $itk_component(pointercontrols) r* -resize none
220
221
222    # setup movie controls
223
224    # Rewind
225    itk_component add rewind {
226        button $itk_component(moviecontrols).reset \
227            -borderwidth 1 -padx 1 -pady 1 \
228            -image [Rappture::icon flow-rewind] \
229            -command [itcl::code $this video seek 0]
230    } {
231        usual
232        ignore -borderwidth
233        rename -highlightbackground -controlbackground controlBackground \
234            Background
235    }
236    Rappture::Tooltip::for $itk_component(rewind) \
237        "Rewind movie"
238
239    # Stop
240    itk_component add stop {
241        button $itk_component(moviecontrols).stop \
242            -borderwidth 1 -padx 1 -pady 1 \
243            -image [Rappture::icon flow-stop] \
244            -command [itcl::code $this video stop]
245    } {
246        usual
247        ignore -borderwidth
248        rename -highlightbackground -controlbackground controlBackground \
249            Background
250    }
251    Rappture::Tooltip::for $itk_component(stop) \
252        "Stop movie"
253
254    # Play
255    itk_component add play {
256        Rappture::PushButton $itk_component(moviecontrols).play \
257            -onimage [Rappture::icon flow-pause] \
258            -offimage [Rappture::icon flow-play] \
259            -variable [itcl::scope _settings($this-play)] \
260            -command [itcl::code $this video play]
261    }
262    set fg [option get $itk_component(hull) font Font]
263    Rappture::Tooltip::for $itk_component(play) \
264        "Play/Pause movie"
265
266    # Loop
267    itk_component add loop {
268        Rappture::PushButton $itk_component(moviecontrols).loop \
269            -onimage [Rappture::icon flow-loop] \
270            -offimage [Rappture::icon flow-loop] \
271            -variable [itcl::scope _settings($this-loop)]
272    }
273    Rappture::Tooltip::for $itk_component(loop) \
274        "Play continuously"
275
276    itk_component add dial {
277        Rappture::Flowdial $itk_component(moviecontrols).dial \
278            -length 10 -valuewidth 0 -valuepadding 0 -padding 6 \
279            -linecolor "" -activelinecolor "" \
280            -min 0.0 -max 1.0 \
281            -variable [itcl::scope _settings($this-currenttime)] \
282            -knobimage [Rappture::icon knob2] -knobposition center@middle
283    } {
284        usual
285        ignore -dialprogresscolor
286        rename -background -controlbackground controlBackground Background
287    }
288    $itk_component(dial) current 0.0
289    bind $itk_component(dial) <<Value>> [itcl::code $this video seek -currenttime]
290
291    # Current Frame Number
292    itk_component add framenum {
293        Rappture::Spinint $itk_component(moviecontrols).framenum \
294            -min 1 -max 1 -width 1 -font "arial 9"
295    } {
296        usual
297        ignore -highlightthickness
298        rename -background -controlbackground controlBackground Background
299    }
300    $itk_component(framenum) value 1
301    bind $itk_component(framenum) <<Value>> \
302        [itcl::code $this video seek -framenum]
303    Rappture::Tooltip::for $itk_component(framenum) \
304        "Set the current frame number"
305
306
307    # Duration
308    itk_component add duration {
309        entry $itk_component(moviecontrols).duration \
310            -textvariable [itcl::scope _settings($this-duration)] \
311            -bg white -width 6 -font "arial 9"
312    } {
313        usual
314        ignore -highlightthickness -background
315    }
316    bind $itk_component(duration) <Return> [itcl::code $this flow duration]
317    bind $itk_component(duration) <Tab> [itcl::code $this flow duration]
318    Rappture::Tooltip::for $itk_component(duration) \
319        "Set duration of movie (format is min:sec)"
320
321
322    itk_component add durationlabel {
323        label $itk_component(moviecontrols).durationl \
324            -text "Duration:" -font $fg \
325            -highlightthickness 0
326    } {
327        usual
328        ignore -highlightthickness
329        rename -background -controlbackground controlBackground Background
330    }
331
332    itk_component add speedlabel {
333        label $itk_component(moviecontrols).speedl -text "Speed:" -font $fg \
334            -highlightthickness 0
335    } {
336        usual
337        ignore -highlightthickness
338        rename -background -controlbackground controlBackground Background
339    }
340
341    # Speed
342    itk_component add speed {
343        Rappture::Flowspeed $itk_component(moviecontrols).speed \
344            -min 1 -max 10 -width 3 -font "arial 9"
345    } {
346        usual
347        ignore -highlightthickness
348        rename -background -controlbackground controlBackground Background
349    }
350    Rappture::Tooltip::for $itk_component(speed) \
351        "Change speed of movie"
352
353    $itk_component(speed) value 1
354    bind $itk_component(speed) <<Value>> [itcl::code $this video speed]
355
356
357    blt::table $itk_component(moviecontrols) \
358        0,0 $itk_component(rewind) -padx {3 0} \
359        0,1 $itk_component(stop) -padx {2 0} \
360        0,2 $itk_component(play) -padx {2 0} \
361        0,3 $itk_component(loop) -padx {2 0} \
362        0,4 $itk_component(dial) -fill x -padx {2 0 } \
363        0,5 $itk_component(framenum) -padx { 0 0} \
364        0,6 $itk_component(duration) -padx { 0 0} \
365        0,7 $itk_component(speed) -padx {2 3}
366
367    blt::table configure $itk_component(moviecontrols) c* -resize none
368    blt::table configure $itk_component(moviecontrols) c4 -resize both
369    blt::table configure $itk_component(moviecontrols) r0 -pady 1
370
371    itk_component add distGauge {
372        Rappture::Gauge $itk_interior.distGauge \
373            -units "m"
374    } {
375        usual
376        rename -background -controlbackground controlBackground Background
377    }
378    Rappture::Tooltip::for $itk_component(distGauge) \
379        "Length of structure"
380
381    bind $itk_component(distGauge) <<Value>> [itcl::code $this updateMeasurements]
382
383    eval itk_initialize $args
384}
385
386# ----------------------------------------------------------------------
387# DESTRUCTOR
388# ----------------------------------------------------------------------
389itcl::body Rappture::VideoViewer::destructor {} {
390    set _sendobjs ""  ;# stop any send in progress
391    $_dispatcher cancel !rebuild
392    $_dispatcher cancel !send_dataobjs
393    $_dispatcher cancel !send_transfunc
394    array unset _settings $this-*
395}
396
397# ----------------------------------------------------------------------
398# load - load a video file
399# ----------------------------------------------------------------------
400itcl::body Rappture::VideoViewer::load {filename} {
401    set _movie [Rappture::Video $filename]
402    set _framerate [${_movie} get framerate]
403    set _mspf [expr round(((1.0/${_framerate})*1000)/pow(2,[$itk_component(speed) value]-1))]
404    # set _mspf 7
405    puts "framerate = ${_framerate}"
406    puts "mspf = ${_mspf}"
407
408    set _imh [image create photo]
409    $_imh put [$_movie next]
410    $itk_component(main) create image 0 0 -anchor nw -image $_imh
411
412    set _lastFrame [$_movie get position end]
413    set offset [expr 1.0/double(${_lastFrame})]
414    puts "end = ${_lastFrame}"
415    puts "offset = $offset"
416    $itk_component(dial) configure -offset $offset
417
418    set lcv ${_lastFrame}
419    set cnt 1
420    while {$lcv > 9} {
421        set lcv [expr $lcv/10]
422        incr cnt
423    }
424    $itk_component(framenum) configure -max ${_lastFrame} -width $cnt
425
426    set pch [$itk_component(pointercontrols) cget -height]
427    set mch [$itk_component(moviecontrols) cget -height]
428    set pch 30
429    set mch 30
430    $itk_component(main) configure -scrollregion [$itk_component(main) bbox all]
431    foreach { x0 y0 x1 y1 } [$itk_component(main) bbox all] break
432    set w [expr abs($x1-$x0)]
433    set h [expr abs($y1-$y0+$pch+$mch)]
434    # $itk_component(main) configure -width $w -height $h
435    .main configure -width $w -height $h
436
437}
438
439# ----------------------------------------------------------------------
440# video - play, stop, rewind, fastforward the video
441# ----------------------------------------------------------------------
442itcl::body Rappture::VideoViewer::video { args } {
443    set ret 0
444    set option [lindex $args 0]
445    switch -- $option {
446        "play" {
447            if {$_settings($this-play) == 1} {
448                # while in play move, you can't seek using the
449                # framenum spinint widget
450                bind $itk_component(framenum) <<Value>> ""
451                # start playing
452                Play
453            } else {
454                # pause
455                after cancel $_id
456                set _settings($this-play) 0
457                # setup seek bindings using the
458                # framenum spinint widget
459                bind $itk_component(framenum) <<Value>> \
460                    [itcl::code $this video seek -framenum]
461            }
462        }
463        "seek" {
464            Seek [lreplace $args 0 0]
465        }
466        "stop" {
467            after cancel $_id
468            set _settings($this-play) 0
469        }
470        "position" {
471            set ret [${_movie} get position cur]
472        }
473        "speed" {
474            set _mspf [expr round(((1.0/${_framerate})*1000)/pow(2,[$itk_component(speed) value]-1))]
475            puts "_mspf = ${_mspf}"
476        }
477        default {
478            error "bad option \"$option\": should be play, stop, toggle, position, or reset."
479        }
480    }
481    return $ret
482}
483
484# ----------------------------------------------------------------------
485# togglePtrCtrl - choose pointer mode:
486#                 rectangle, distance, measure, particlemark
487# ----------------------------------------------------------------------
488itcl::body Rappture::VideoViewer::togglePtrCtrl {pbvar} {
489
490    upvar 1 $pbvar inState
491    puts "togglePtrCtrl to $pbvar"
492    if {$inState == 1} {
493        # unpush previously pushed buttons
494        foreach pbv $_pbvlist {
495            if {[string compare $pbvar $pbv] != 0} {
496                upvar 1 $pbv var
497                set var 0
498            }
499        }
500    }
501    togglePtrBind $pbvar
502}
503
504
505# ----------------------------------------------------------------------
506# whatPtrCtrl - figure out the current pointer mode:
507#                 rectangle, distance, measure, particlemark
508# ----------------------------------------------------------------------
509itcl::body Rappture::VideoViewer::whatPtrCtrl {} {
510    foreach pbv $_pbvlist {
511        upvar #0 $pbv var
512        if {$var != "" && $var != 0} {
513            return $pbv
514        }
515    }
516}
517
518
519# ----------------------------------------------------------------------
520# togglePtrBind - update the bindings based on pointer controls
521# ----------------------------------------------------------------------
522itcl::body Rappture::VideoViewer::togglePtrBind {pbvar} {
523
524    if {[string compare $pbvar current] == 0} {
525        set pbvar [whatPtrCtrl]
526    }
527
528    if {[string compare $pbvar rectPbVar] == 0} {
529
530        # Bindings for selecting rectangle
531        $itk_component(main) configure -cursor ""
532
533        bind $itk_component(main) <ButtonPress-1> \
534            [itcl::code $this Rubberband new %W %x %y]
535        bind $itk_component(main) <B1-Motion> \
536            [itcl::code $this Rubberband drag %W %x %y]
537        bind $itk_component(main) <ButtonRelease-1> \
538            [itcl::code $this Rubberband release %W %x %y]
539
540    } elseif {[string compare $pbvar distPbVar] == 0} {
541
542        # Bindings for setting distance
543        $itk_component(main) configure -cursor ""
544
545        bind $itk_component(main) <ButtonPress-1> \
546            [itcl::code $this Distance new %W %x %y]
547        bind $itk_component(main) <B1-Motion> \
548            [itcl::code $this Distance drag %W %x %y]
549        bind $itk_component(main) <ButtonRelease-1> \
550            [itcl::code $this Distance release %W %x %y]
551
552    } elseif {[string compare $pbvar measPbVar] == 0} {
553
554        # Bindings for measuring distance
555        $itk_component(main) configure -cursor ""
556
557        bind $itk_component(main) <ButtonPress-1> \
558            [itcl::code $this Measure new %W %x %y]
559        bind $itk_component(main) <B1-Motion> \
560            [itcl::code $this Measure drag %W %x %y]
561        bind $itk_component(main) <ButtonRelease-1> \
562            [itcl::code $this Measure release %W %x %y]
563
564    } elseif {[string compare $pbvar partPbVar] == 0} {
565
566        # Bindings for marking particle locations
567        $itk_component(main) configure -cursor ""
568
569        bind $itk_component(main) <ButtonPress-1> \
570            [itcl::code $this Particle new %W %x %y]
571        bind $itk_component(main) <B1-Motion> ""
572        bind $itk_component(main) <ButtonRelease-1> ""
573
574    } elseif {[string compare $pbvar particle] == 0} {
575
576        # Bindings for interacting with particles
577        $itk_component(main) configure -cursor hand2
578
579        bind $itk_component(main) <ButtonPress-1> ""
580        bind $itk_component(main) <B1-Motion> ""
581        bind $itk_component(main) <ButtonRelease-1> ""
582
583    } else {
584
585        # invalid pointer mode
586
587    }
588}
589
590
591# ----------------------------------------------------------------------
592# play - get the next video frame
593# ----------------------------------------------------------------------
594itcl::body Rappture::VideoViewer::Play {} {
595
596    set cur [$_movie get position cur]
597
598#    # this probably is incorrect because other people
599#    # could schedule stuff in the after queue
600#    if {[llength [after info]] > 1} {
601#        # drop frames that get caught up in the "after queue"
602#        # in order to keep up with the frame rate
603#        #foreach i [after info] {
604#        #    after cancel $i
605#        #}
606#        incr _waiting
607#    } else {
608#        # display the next frame
609#        $_imh put [$_movie seek +[incr _waiting]]
610#        set _waiting 0
611#
612#        # update the dial and framenum widgets
613#        set _settings($this-currenttime) [expr 1.0*$cur/${_lastFrame}]
614#        $itk_component(framenum) value $cur
615#
616#    }
617
618    # display the next frame
619    $_imh put [$_movie next]
620
621    # update the dial and framenum widgets
622    set _settings($this-currenttime) [expr 1.0*$cur/${_lastFrame}]
623    $itk_component(framenum) value $cur
624
625    if {[expr $cur%100] == 0} {
626        puts "after: [after info]"
627        puts "id = ${_id}"
628    }
629
630    # schedule the next frame to be displayed
631    if {$cur < ${_lastFrame}} {
632        set _id [after ${_mspf} [itcl::code $this Play]]
633    }
634}
635
636
637# ----------------------------------------------------------------------
638# Seek - go to a frame in the video video frame
639#   Seek -percent 43
640#   Seek -percent 0.5
641#   Seek +5
642#   Seek -5
643#   Seek 35
644#   Seek -currenttime
645#   Seek -framenum
646# ----------------------------------------------------------------------
647itcl::body Rappture::VideoViewer::Seek {args} {
648    set option [lindex $args 0]
649    switch -- $option {
650        "-percent" {
651            set val [lindex $args 1]
652            if {[string is integer -strict $val] == 1} {
653                set val [expr double($val) / 100.0]
654            }
655            # convert the percentage to a frame number (new cur)
656            set val [expr int($val * ${_lastFrame})]
657        }
658        "-currenttime" {
659            set val $_settings($this-currenttime)
660            set val [expr round($val * ${_lastFrame})]
661        }
662        "-framenum" {
663            set val [$itk_component(framenum) value]
664        }
665        default {
666            set val $option
667        }
668    }
669    if {"" == $val} {
670        error "bad value: \"$val\": should be \"seek \[-percent\] value\""
671    }
672    $_imh put [$_movie seek $val]
673    set cur [$_movie get position cur]
674    set _settings($this-currenttime) [expr double($cur) / double(${_lastFrame})]
675}
676
677
678# ----------------------------------------------------------------------
679# Rubberband - draw a rubberband around something in the canvas
680# ----------------------------------------------------------------------
681itcl::body Rappture::VideoViewer::Rubberband {status win x y} {
682    switch -- $status {
683        "new" {
684            $win delete "rubbershape"
685            set _x0 $x
686            set _y0 $y
687            $win create rectangle \
688                $x $y $x $y -outline white -width 2  \
689                -tags "rubbershape" -dash {4 4}
690        }
691        "drag" {
692            foreach { x0 y0 x1 y1 } [$win coords "rubbershape"] break
693
694            if {$_x0 > $x} {
695                # backward direction
696                set x0 $x
697                set x1 $_x0
698            } else {
699                set x1 $x
700            }
701
702            if {$_y0 >= $y} {
703                # backward direction
704                set y0 $y
705                set y1 $_y0
706            } else {
707                set y1 $y
708            }
709
710            eval $win coords "rubbershape" [list $x0 $y0 $x1 $y1]
711        }
712        "release" {
713            Rubberband drag $win $x $y
714        }
715        default {
716            error "bad status \"$status\": should be new, drag, or release"
717        }
718    }
719}
720
721# ----------------------------------------------------------------------
722# updateMeasurements - update measurements based on provided distance
723# ----------------------------------------------------------------------
724itcl::body Rappture::VideoViewer::updateMeasurements {} {
725    foreach { x0 y0 x1 y1 } [$itk_component(main) bbox "distance"] break
726    set px [expr sqrt(pow(($x1-$x0),2)+pow(($y1-$y0),2))]
727    set dist [Rappture::Units::convert [$itk_component(distGauge) value] -units off]
728    set px2dist [expr $dist/$px]
729    if {$px2dist != ${_px2dist}} {
730        set _px2dist $px2dist
731    }
732
733    # if measure lines exist, update their values
734    foreach tag ${_measTags} {
735        foreach { x0 y0 x1 y1 } [$itk_component(main) bbox $tag] break
736        set px [expr sqrt(pow(($x1-$x0),2)+pow(($y1-$y0),2))]
737        set dist [expr $px*${_px2dist}]
738        regexp {measure(\d+)} $tag match cnt
739        $itk_component(measGauge$cnt) value $dist
740    }
741}
742
743# ----------------------------------------------------------------------
744# Distance - draw a line to measure something on the canvas,
745#            when user releases the line, user is prompted for
746#            a measurement which is stored and used as the bases
747#            for future distance calculations.
748# ----------------------------------------------------------------------
749itcl::body Rappture::VideoViewer::Distance {status win x y} {
750    switch -- $status {
751        "new" {
752            $win delete "distance"
753            $win delete "distance-val"
754            $win create line \
755                $x $y $x $y -fill red -width 2  \
756                -tags "distance" -dash {4 4} -arrow both
757        }
758        "drag" {
759            set coords [$win coords "distance"]
760            eval $win coords "distance" [lreplace $coords 2 3 $x $y]
761        }
762        "release" {
763            Distance drag $win $x $y
764            foreach { x0 y0 x1 y1 } [$itk_component(main) bbox "distance"] break
765            set rootx [winfo rootx $itk_component(main)]
766            set rooty [winfo rooty $itk_component(main)]
767            set x [expr "$x0 + (abs($x1-$x0)/2)"]
768            set y [expr "$y0 + (abs($y1-$y0)/2)"]
769            $itk_component(main) create window $x $y \
770                -window $itk_component(distGauge) \
771                -anchor center \
772                -tags "distance-val"
773        }
774        default {
775            error "bad status \"$status\": should be new, drag, or release"
776        }
777    }
778}
779# ----------------------------------------------------------------------
780# Measure - draw a line to measure something on the canvas,
781#           when user releases the line, user is given the
782#           calculated measurement.
783# ----------------------------------------------------------------------
784itcl::body Rappture::VideoViewer::Measure {status win x y} {
785    switch -- $status {
786        "new" {
787            $win delete "measure"
788            $win create line \
789                $x $y $x $y -fill green -width 2  \
790                -tags "measure" -dash {4 4} -arrow both
791        }
792        "drag" {
793            set coords [$win coords "measure"]
794            eval $win coords "measure" [lreplace $coords 2 3 $x $y]
795        }
796        "release" {
797            # finish drawing the measuring line
798            Measure drag $win $x $y
799
800            # calculate the location on the measuring line to place gauge
801            foreach { x0 y0 x1 y1 } [$itk_component(main) bbox "measure"] break
802            puts "bbox for $_measCnt is ($x0,$y0) ($x1,$y1)"
803            set rootx [winfo rootx $itk_component(main)]
804            set rooty [winfo rooty $itk_component(main)]
805            set x [expr "$x0 + (abs($x1-$x0)/2)"]
806            set y [expr "$y0 + (abs($y1-$y0)/2)"]
807
808#            set popup ".measure$_measCnt-popup"
809#            if { ![winfo exists $popup] } {
810#                # Create a popup for the measure line dialog
811#                Rappture::Balloon $popup -title "Configure measurement..."
812#                set inner [$popup component inner]
813#                # Create the print dialog widget and add it to the
814#                # the balloon popup.
815#                Rappture::XyPrint $inner.print-
816#                $popup configure \
817#                    -deactivatecommand [list $inner.print reset]-
818#                blt::table $inner 0,0 $inner.print -fill both
819#            }
820#
821#
822            # create a new gauge for this measuring line
823            itk_component add measGauge$_measCnt {
824                Rappture::Gauge $itk_interior.measGauge$_measCnt \
825                    -units "m"
826            } {
827                usual
828                rename -background -controlbackground controlBackground Background
829            }
830            Rappture::Tooltip::for $itk_component(measGauge$_measCnt) \
831                "Length of structure $_measCnt"
832
833            # place the gauge on the measuring line
834            $itk_component(main) create window $x $y \
835                -window $itk_component(measGauge$_measCnt) \
836                -anchor center \
837                -tags "measure$_measCnt-val"
838
839            # set the value of the gauge with the calculated distance
840            set px [expr sqrt(pow(($x1-$x0),2)+pow(($y1-$y0),2))]
841            set dist [expr $px*$_px2dist]
842            $itk_component(measGauge$_measCnt) value $dist
843
844            # rename the tag for the line
845            # so we can have multiple measure lines
846            # store tag name for future value updates
847            $itk_component(main) addtag "measure$_measCnt" withtag "measure"
848            $itk_component(main) dtag "measure" "measure"
849            lappend _measTags "measure$_measCnt"
850            incr _measCnt
851        }
852        default {
853            error "bad status \"$status\": should be new, drag, or release"
854        }
855    }
856}
857
858# ----------------------------------------------------------------------
859# Particle - mark a particle in the video, a new particle object is
860#            created from information like the name, which video
861#            frames it lives in, it's coords in the canvas in each
862#            frame, it's color...
863# ----------------------------------------------------------------------
864itcl::body Rappture::VideoViewer::Particle {status win x y} {
865    switch -- $status {
866        "new" {
867            incr _pcnt
868            puts "pcnt = ${_pcnt}"
869            set name "particle${_pcnt}"
870            set p [Rappture::VideoParticle $itk_component(main).#auto $win \
871                    -fncallback [itcl::code $this video position cur] \
872                    -trajcallback [itcl::code $this Trajectory] \
873                    -halo 5 \
874                    -name $name \
875                    -color green]
876            set frameNum [$_movie get position cur]
877            $p Add frame $frameNum $x $y
878            $p Show particle
879
880            # link the new particle to the last particle added
881            set lastp ""
882            while {[llength ${_particles}] > 0} {
883                set lastp [lindex ${_particles} end]
884                if {[llength [$lastp Coords]] != 0} {
885                    break
886                } else {
887                    set _particles [lreplace ${_particles} end end]
888                    set lastp ""
889                }
890            }
891
892            if {[string compare "" $lastp] != 0} {
893                $lastp Link $p
894                bind $lastp <<Motion>> [itcl::code $lastp drawVectors]]
895            }
896
897
898            # add the particle to the list
899            lappend _particles $p
900
901            $win bind $name <ButtonPress-1> [itcl::code $p Move press %x %y]
902            $win bind $name <B1-Motion> [itcl::code $p Move motion %x %y]
903            $win bind $name <ButtonRelease-1> [itcl::code $p Move release %x %y]
904
905            $win bind $name <ButtonPress-3> [itcl::code $p Menu activate %x %y]
906
907            $win bind $name <Enter> [itcl::code $this togglePtrBind particle]
908            $win bind $name <Leave> [itcl::code $this togglePtrBind current]
909
910#            set pm [Rappture::VideoParticleManager]
911#            $pm add $p0
912#            set plist [$pm list]
913        }
914        default {
915            error "bad status \"$status\": should be new, drag, or release"
916        }
917    }
918}
919
920# ----------------------------------------------------------------------
921# Trajectory - draw a trajectory between two particles
922# ----------------------------------------------------------------------
923itcl::body Rappture::VideoViewer::Trajectory {args} {
924
925    set nargs [llength $args]
926    if {($nargs != 1) && ($nargs != 2)} {
927        error "wrong # args: should be \"Trajectory p0 p1\""
928    }
929
930    set p0 ""
931    set p1 ""
932    foreach {p0 p1} $args break
933
934    if {[string compare "" $p0] == 0} {
935        # p0 does not exist
936        return
937    }
938
939    # remove any old trajectory links from p0
940    set p0name [$p0 cget -name]
941    set oldlink "vec-$p0name"
942    puts "removing $oldlink"
943    $itk_component(main) delete $oldlink
944
945    # check to see if p1 exists anymore
946    if {[string compare "" $p1] == 0} {
947        # p1 does not exist
948        return
949    }
950
951    foreach {x0 y0} [$p0 Coords] break
952    foreach {x1 y1} [$p1 Coords] break
953    set p1name [$p1 cget -name]
954    set link "vec-$p0name-$p1name"
955    puts "adding $link"
956    $itk_component(main) create line $x0 $y0 $x1 $y1 \
957        -fill green \
958        -width 2 \
959        -tags "vector $link vec-$p0name" \
960        -dash {4 4} \
961        -arrow last
962
963    # calculate trajectory, truncate it after 4 sigdigs
964    puts "---------$link---------"
965    set t [calculateTrajectory [$p0 Frame] $x0 $y0 [$p1 Frame] $x1 $y1]
966    set tt [string range $t 0 [expr [string first . $t] + 4]]
967
968
969    # calculate coords for text
970    foreach { x0 y0 x1 y1 } [$itk_component(main) bbox $link] break
971    set x [expr "$x0 + (abs($x1-$x0)/2)"]
972    set y [expr "$y0 + (abs($y1-$y0)/2)"]
973
974    $itk_component(main) create text $x $y \
975        -tags "vectext $link vec-$p0name" \
976        -justify center \
977        -text "$tt [$itk_component(distGauge) cget -units]/s" \
978        -fill green \
979        -width [expr sqrt(pow(abs($x1-$x0),2)+pow(abs($y1-$y0),2))]
980}
981
982# ----------------------------------------------------------------------
983# calculateTrajectory - calculate the value of the trajectory
984# ----------------------------------------------------------------------
985itcl::body Rappture::VideoViewer::calculateTrajectory {args} {
986    # set framerate 29.97         ;# frames per second
987    # set px2dist    8.00         ;# px per meter
988
989    foreach {f0 x0 y0 f1 x1 y1} $args break
990    set px [expr sqrt(pow(abs($x1-$x0),2)+pow(abs($y1-$y0),2))]
991    set frames [expr $f1 - $f0]
992
993    if {($frames != 0) && (${_px2dist} != 0)} {
994        set t [expr 1.0*$px/$frames/${_px2dist}*${_framerate}]
995    } else {
996        set t 0.0
997    }
998
999    puts "px = $px"
1000    puts "frames = $frames"
1001    puts "px2dist = ${_px2dist}"
1002    puts "framerate = ${_framerate}"
1003    puts "trajectory = $t"
1004
1005    return $t
1006}
1007
Note: See TracBrowser for help on using the repository browser.