Changeset 1919 for branches/blt4

Timestamp:

Oct 17, 2010, 8:47:44 PM (14 years ago)

Author:

gah

Message:

 

Location:

branches/blt4/gui/scripts

Files:

• Makefile.in (modified) (1 diff)
• barresult.tcl (modified) (3 diffs)
• flowvisviewer.tcl (modified) (1 diff)
• getopts.tcl (modified) (2 diffs)
• histogram.tcl (modified) (1 diff)
• historesult.tcl (modified) (6 diffs)
• videoparticle.tcl (added)
• videoviewer.tcl (modified) (25 diffs)

branches/blt4/gui/scripts/Makefile.in

@@ -117 +117 @@
                 $(srcdir)/valueresult.tcl \
                 $(srcdir)/videoviewer.tcl \
+                $(srcdir)/videoparticle.tcl \
                 $(srcdir)/visviewer.tcl \
                 $(srcdir)/vtkviewer.tcl \

branches/blt4/gui/scripts/barresult.tcl

@@ -106 +106 @@
 
     private variable _dispatcher "" ;# dispatcher for !events
-    private variable _dlist ""     ;# list of dataobj objects
+    private variable _dlist ""     ;# list of dataobjs
     private variable _dataobj2color  ;# maps dataobj => plotting color
     private variable _dataobj2width  ;# maps dataobj => line width
@@ -916 +916 @@
             
             # Some elements are generated dynamically and therefore will
-            # not have a dataobj object associated with them.
+            # not have a dataobj associated with them.
             set mapx [$g element cget $elem -mapx]
             set mapy [$g element cget $elem -mapy]
@@ -958 +958 @@
                 
                 # Some elements are generated dynamically and therefore will
-                # not have a dataobj object associated with them.
+                # not have a dataobj associated with them.
                 set mapx [$g element cget $elem -mapx]
                 set mapy [$g element cget $elem -mapy]

branches/blt4/gui/scripts/flowvisviewer.tcl

@@ -2788 +2788 @@
             if { $_settings($this-currenttime) >= $_flow(duration) } {
                 if { !$_settings($this-loop) } {
-                    flow off
+                    flow off
                     return
                 }

branches/blt4/gui/scripts/getopts.tcl

@@ -47 +47 @@
     #
     foreach line [split $spec \n] {
-        if {[llength $line] == 0} {
-            continue  ;# ignore blank lines
-        }
+        if {[llength $line] == 0} {
+            continue  ;# ignore blank lines
+        }
 
-        set type [lindex $line 0]
-        switch -- $type {
-            value {
-                if {[llength $line] < 3} {
-                    error "bad value spec \"$line\": should be \"value -flag default\""
-                }
-                set name [lindex $line 1]
-                set flags($name) $type
-                set params($name) [lindex $line 2]
-                lappend opts $name
-            }
-            flag {
-                if {[llength $line] < 3 || [llength $line] > 4} {
-                    error "bad value spec \"$line\": should be \"flag group -flag ?default?\""
-                }
-                set group [lindex $line 1]
-                set name [lindex $line 2]
-                set flags($name) [list $type $group]
-                if {[llength $line] > 3} {
-                    set params($group) $name
-                    set params($name) 1
-                } else {
-                    if {![info exists params($group)]} {
-                        set params($group) ""
-                    }
-                    set params($name) 0
-                }
-                lappend opts $name
-            }
-            list {
-                if {[llength $line] < 3} {
-                    error "bad value spec \"$line\": should be \"list -flag default\""
-                }
-                set name [lindex $line 1]
-                set flags($name) $type
-                set params($name) [lindex $line 2]
-                lappend opts $name
-            }
-            default {
-                error "bad arg type \"$type\": should be flag or value"
-            }
-        }
+        set type [lindex $line 0]
+        switch -- $type {
+            value {
+                if {[llength $line] < 3} {
+                    error "bad value spec \"$line\": should be \"value -flag default\""
+                }
+                set name [lindex $line 1]
+                set flags($name) $type
+                set params($name) [lindex $line 2]
+                lappend opts $name
+            }
+            flag {
+                if {[llength $line] < 3 || [llength $line] > 4} {
+                    error "bad value spec \"$line\": should be \"flag group -flag ?default?\""
+                }
+                set group [lindex $line 1]
+                set name [lindex $line 2]
+                set flags($name) [list $type $group]
+                if {[llength $line] > 3} {
+                    set params($group) $name
+                    set params($name) 1
+                } else {
+                    if {![info exists params($group)]} {
+                        set params($group) ""
+                    }
+                    set params($name) 0
+                }
+                lappend opts $name
+            }
+            list {
+                if {[llength $line] < 3} {
+                    error "bad value spec \"$line\": should be \"list -flag default\""
+                }
+                set name [lindex $line 1]
+                set flags($name) $type
+                set params($name) [lindex $line 2]
+                lappend opts $name
+            }
+            default {
+                error "bad arg type \"$type\": should be flag or value"
+            }
+        }
     }
 
@@ -99 +99 @@
     #
     while {[llength $args] > 0} {
-        set first [lindex $args 0]
-        if {[string index $first 0] != "-"} {
-            break
-        }
-        if {"--" == $first} {
-            set args [lrange $args 1 end]
-            break
-        }
-        if {![info exists params($first)]} {
-            error "bad option \"$first\": should be [join [lsort $opts] {, }]"
-        }
-        switch -- [lindex $flags($first) 0] {
-            value {
-                if {[llength $args] < 2} {
-                    error "missing value for option $first"
-                }
-                set params($first) [lindex $args 1]
-                set args [lrange $args 2 end]
-            }
-            flag {
-                set group [lindex $flags($first) 1]
-                set params($group) $first
-                set params($first) 1
-                set args [lrange $args 1 end]
-            }
-            list {
-                if {[llength $args] < 2} {
-                    error "missing value for option $first"
-                }
-                set params($first) [lrange $args 1 end]
-                set args ""
-            }
-        }
+        set first [lindex $args 0]
+        if {[string index $first 0] != "-"} {
+            break
+        }
+        if {"--" == $first} {
+            set args [lrange $args 1 end]
+            break
+        }
+        if {![info exists params($first)]} {
+            error "bad option \"$first\": should be [join [lsort $opts] {, }]"
+        }
+        switch -- [lindex $flags($first) 0] {
+            value {
+                if {[llength $args] < 2} {
+                    error "missing value for option $first"
+                }
+                set params($first) [lindex $args 1]
+                set args [lrange $args 2 end]
+            }
+            flag {
+                set group [lindex $flags($first) 1]
+                set params($group) $first
+                set params($first) 1
+                set args [lrange $args 1 end]
+            }
+            list {
+                if {[llength $args] < 2} {
+                    error "missing value for option $first"
+                }
+                foreach arg [lrange $args 1 end] {
+                    if {[string index $arg 0] == "-"} {
+                        break
+                    }
+                }
+                set idx [lsearch -exact $args $arg]
+                if {$idx == [expr [llength $args] - 1]} {
+                    # reached the end of the $args list
+                    # with no other -'d arguments
+                    set params($first) [lrange $args 1 end]
+                    set args ""
+                } else {
+                    # there are further -'d arguments to process
+                    set params($first) [lrange $args 1 [expr $idx-1]]
+                    set args [lrange $args $idx end]
+                }
+            }
+        }
     }
     return ""

branches/blt4/gui/scripts/histogram.tcl

@@ -155 +155 @@
             error "bad option \"$which\": should be x, xlin, xlog, y, ylin, ylog"
         }
+    }
+    if {"" == $vname} {
+        return {0 1}
     }
     $vname dup tmp

branches/blt4/gui/scripts/historesult.tcl

@@ -75 +75 @@
 }
 
-option add *XyResult.autoColors $autocolors widgetDefault
-option add *XyResult*Balloon*Entry.background white widgetDefault
+option add *HistogramResult.autoColors $autocolors widgetDefault
+option add *HistogramResult*Balloon*Entry.background white widgetDefault
 
 itcl::class Rappture::HistogramResult {
@@ -488 +488 @@
         }
         controls {
-            set popup .historesultdownload
-            if {![winfo exists .historesultdownload]} {
+            set popup .histogramresultdownload
+            if {![winfo exists .histogramresultdownload]} {
                 # if we haven't created the popup yet, do it now
                 Rappture::Balloon $popup \
@@ -517 +517 @@
         }
         now {
-            set popup .historesultdownload
-            if {[winfo exists .historesultdownload]} {
+            set popup .histogramresultdownload
+            if {[winfo exists .histogramresultdownload]} {
                 $popup deactivate
             }
@@ -564 +564 @@
                 }
                 image {
-                    set popup .histoprintdownload
+                    set popup .histogramprintdownload
                     if { ![winfo exists $popup] } {
                         # Create a popup for the print dialog
@@ -727 +727 @@
             foreach x [$xv values] y [$yv values] z [$zv values] {
                 set elem "elem[incr count]"
-                set _elem2histo($elem) $dataobj
+                set _elem2dataobj($elem) $dataobj
                 $g element create $elem -x $x -y $y -barwidth $z \
                     -label $label -foreground $color \
@@ -736 +736 @@
             set z [expr {$r / ([$xv length]-1) * 0.8}]
             set elem "elem[incr count]"
-            set _elem2histo($elem) $dataobj
+            set _elem2dataobj($elem) $dataobj
             $g element create $elem -x $xv -y $yv -barwidth $z \
                     -label $label -foreground $color \

branches/blt4/gui/scripts/videoviewer.tcl

@@ -45 +45 @@
     public method video {args}
 
+    protected method togglePtrBind {pbvar}
     protected method togglePtrCtrl {pbvar}
-    protected method togglePtrBind {pbvar}
+    protected method whatPtrCtrl {}
 
     protected method Play {}
+    protected method Seek {n}
     protected method Rubberband {status win x y}
     protected method Distance {status win x y}
     protected method Measure {status win x y}
+    protected method Particle {status win x y}
+    protected method Trajectory {args}
     protected method updateMeasurements {}
+    protected method calculateTrajectory {args}
 
     private common   _settings
@@ -62 +67 @@
     private variable _units "m"
     private variable _movie ""      ;# movie we grab images from
+    private variable _lastFrame 0   ;# last frame in the movie
     private variable _imh ""        ;# current image being displayed
     private variable _id ""         ;# id of the next play command from after
     private variable _pbvlist ""    ;# list of push button variables
     private variable _px2dist 0     ;# conversion for screen px to distance
+    private variable _measCnt 0     ;# count of the number measure lines
+    private variable _measTags ""   ;# list of measure line tags on canvas
+    private variable _particles ""  ;# list of particles
+    private variable _pcnt -1       ;# particle count
+    private variable _framerate 30  ;# video frame rate
+    private variable _mspf 20       ;# milliseconds per frame wait time
+    private variable _waiting 0     ;# number of frames behind we are
 }
 
@@ -81 +94 @@
         $this-arrows            0
         $this-currenttime       0
+        $this-framenum          0
         $this-duration          1:00
         $this-loop              0
@@ -179 +193 @@
 
 
+
+    # ==== particle mark tool ====
+    set particleImg [image create photo -file [file join $imagesDir "volume-on.gif"]]
+    itk_component add particle {
+        Rappture::PushButton $itk_component(pointercontrols).particlepb \
+            -onimage $particleImg \
+            -offimage $particleImg \
+            -command [itcl::code $this togglePtrCtrl partPbVar] \
+            -variable partPbVar
+    } {
+        usual
+    }
+    Rappture::Tooltip::for $itk_component(particle) \
+        "Mark the location of a particle to follow"
+
+    lappend _pbvlist partPbVar
+
     blt::table $itk_component(pointercontrols) \
         0,0 $itk_component(rectangle) -pady {3 0} \
         0,1 $itk_component(distance) -pady {3 0} \
-        0,2 $itk_component(measure) -pady {3 0}
+        0,2 $itk_component(measure) -pady {3 0} \
+        0,3 $itk_component(particle) -pady {3 0}
 
     blt::table configure $itk_component(pointercontrols) c* -resize none
@@ -195 +227 @@
             -borderwidth 1 -padx 1 -pady 1 \
             -image [Rappture::icon flow-rewind] \
-            -command [itcl::code $this video reset]
+            -command [itcl::code $this video seek 0]
     } {
         usual
@@ -255 +287 @@
     }
     $itk_component(dial) current 0.0
-    bind $itk_component(dial) <<Value>> [itcl::code $this flow goto]
+    bind $itk_component(dial) <<Value>> [itcl::code $this video seek -currenttime]
+
+    # Current Frame Number
+    itk_component add framenum {
+        Rappture::Spinint $itk_component(moviecontrols).framenum \
+            -min 1 -max 1 -width 1 -font "arial 9"
+    } {
+        usual
+        ignore -highlightthickness
+        rename -background -controlbackground controlBackground Background
+    }
+    $itk_component(framenum) value 1
+    bind $itk_component(framenum) <<Value>> \
+        [itcl::code $this video seek -framenum]
+    Rappture::Tooltip::for $itk_component(framenum) \
+        "Set the current frame number"
+
+
     # Duration
     itk_component add duration {
@@ -303 +352 @@
 
     $itk_component(speed) value 1
-    bind $itk_component(speed) <<Value>> [itcl::code $this flow speed]
+    bind $itk_component(speed) <<Value>> [itcl::code $this video speed]
 
 
@@ -312 +361 @@
         0,3 $itk_component(loop) -padx {2 0} \
         0,4 $itk_component(dial) -fill x -padx {2 0 } \
-        0,5 $itk_component(duration) -padx { 0 0} \
+        0,5 $itk_component(framenum) -padx { 0 0} \
+        0,6 $itk_component(duration) -padx { 0 0} \
         0,7 $itk_component(speed) -padx {2 3}
 
@@ -327 +377 @@
     }
     Rappture::Tooltip::for $itk_component(distGauge) \
-        "Length of structure"
-
-    itk_component add measGauge {
-        Rappture::Gauge $itk_interior.measGauge \
-            -units "m"
-    } {
-        usual
-        rename -background -controlbackground controlBackground Background
-    }
-    Rappture::Tooltip::for $itk_component(measGauge) \
         "Length of structure"
 
@@ -359 +399 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::VideoViewer::load {filename} {
-    set _movie [Rappture::MediaPlayer $filename]
+    set _movie [Rappture::Video $filename]
+    set _framerate [${_movie} get framerate]
+    set _mspf [expr round(((1.0/${_framerate})*1000)/pow(2,[$itk_component(speed) value]-1))]
+    # set _mspf 7
+    puts "framerate = ${_framerate}"
+    puts "mspf = ${_mspf}"
 
     set _imh [image create photo]
-    $_imh put [$_movie read]
+    $_imh put [$_movie next]
     $itk_component(main) create image 0 0 -anchor nw -image $_imh
 
+    set _lastFrame [$_movie get position end]
+    set offset [expr 1.0/double(${_lastFrame})]
+    puts "end = ${_lastFrame}"
+    puts "offset = $offset"
+    $itk_component(dial) configure -offset $offset
+
+    set lcv ${_lastFrame}
+    set cnt 1
+    while {$lcv > 9} {
+        set lcv [expr $lcv/10]
+        incr cnt
+    }
+    $itk_component(framenum) configure -max ${_lastFrame} -width $cnt
+
+    set pch [$itk_component(pointercontrols) cget -height]
+    set mch [$itk_component(moviecontrols) cget -height]
+    set pch 30
+    set mch 30
     $itk_component(main) configure -scrollregion [$itk_component(main) bbox all]
     foreach { x0 y0 x1 y1 } [$itk_component(main) bbox all] break
     set w [expr abs($x1-$x0)]
-    set h [expr abs($y1-$y0)]
-    $itk_component(main) configure -width $w -height $h
+    set h [expr abs($y1-$y0+$pch+$mch)]
+    # $itk_component(main) configure -width $w -height $h
     .main configure -width $w -height $h
 
@@ -378 +441 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::VideoViewer::video { args } {
+    set ret 0
     set option [lindex $args 0]
     switch -- $option {
         "play" {
             if {$_settings($this-play) == 1} {
+                # while in play move, you can't seek using the
+                # framenum spinint widget
+                bind $itk_component(framenum) <<Value>> ""
                 # start playing
                 Play
@@ -388 +455 @@
                 after cancel $_id
                 set _settings($this-play) 0
+                # setup seek bindings using the
+                # framenum spinint widget
+                bind $itk_component(framenum) <<Value>> \
+                    [itcl::code $this video seek -framenum]
             }
         }
         "seek" {
+            Seek [lreplace $args 0 0]
         }
         "stop" {
@@ -396 +468 @@
             set _settings($this-play) 0
         }
+        "position" {
+            set ret [${_movie} get position cur]
+        }
+        "speed" {
+            set _mspf [expr round(((1.0/${_framerate})*1000)/pow(2,[$itk_component(speed) value]-1))]
+            puts "_mspf = ${_mspf}"
+        }
         default {
-            error "bad option \"$option\": should be play, stop, toggle, or reset."
-        }
-    }
+            error "bad option \"$option\": should be play, stop, toggle, position, or reset."
+        }
+    }
+    return $ret
 }
 
 # ----------------------------------------------------------------------
 # togglePtrCtrl - choose pointer mode:
-#                 rectangle, distance, or measure
+#                 rectangle, distance, measure, particlemark
 # ----------------------------------------------------------------------
 itcl::body Rappture::VideoViewer::togglePtrCtrl {pbvar} {
 
     upvar 1 $pbvar inState
-
+    puts "togglePtrCtrl to $pbvar"
     if {$inState == 1} {
         # unpush previously pushed buttons
@@ -424 +504 @@
 
 # ----------------------------------------------------------------------
+# whatPtrCtrl - figure out the current pointer mode:
+#                 rectangle, distance, measure, particlemark
+# ----------------------------------------------------------------------
+itcl::body Rappture::VideoViewer::whatPtrCtrl {} {
+    foreach pbv $_pbvlist {
+        upvar #0 $pbv var
+        if {$var != "" && $var != 0} {
+            return $pbv
+        }
+    }
+}
+
+
+# ----------------------------------------------------------------------
 # togglePtrBind - update the bindings based on pointer controls
 # ----------------------------------------------------------------------
 itcl::body Rappture::VideoViewer::togglePtrBind {pbvar} {
 
+    if {[string compare $pbvar current] == 0} {
+        set pbvar [whatPtrCtrl]
+    }
+
     if {[string compare $pbvar rectPbVar] == 0} {
 
         # Bindings for selecting rectangle
+        $itk_component(main) configure -cursor ""
+
         bind $itk_component(main) <ButtonPress-1> \
             [itcl::code $this Rubberband new %W %x %y]
@@ -441 +541 @@
 
         # Bindings for setting distance
+        $itk_component(main) configure -cursor ""
+
         bind $itk_component(main) <ButtonPress-1> \
             [itcl::code $this Distance new %W %x %y]
@@ -451 +553 @@
 
         # Bindings for measuring distance
+        $itk_component(main) configure -cursor ""
+
         bind $itk_component(main) <ButtonPress-1> \
             [itcl::code $this Measure new %W %x %y]
@@ -458 +562 @@
             [itcl::code $this Measure release %W %x %y]
 
+    } elseif {[string compare $pbvar partPbVar] == 0} {
+
+        # Bindings for marking particle locations
+        $itk_component(main) configure -cursor ""
+
+        bind $itk_component(main) <ButtonPress-1> \
+            [itcl::code $this Particle new %W %x %y]
+        bind $itk_component(main) <B1-Motion> ""
+        bind $itk_component(main) <ButtonRelease-1> ""
+
+    } elseif {[string compare $pbvar particle] == 0} {
+
+        # Bindings for interacting with particles
+        $itk_component(main) configure -cursor hand2
+
+        bind $itk_component(main) <ButtonPress-1> ""
+        bind $itk_component(main) <B1-Motion> ""
+        bind $itk_component(main) <ButtonRelease-1> ""
+
     } else {
 
@@ -463 +586 @@
 
     }
-
 }
 
@@ -471 +593 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::VideoViewer::Play {} {
-    $_imh put [$_movie read]
-    set _id [after 20 [itcl::code $this Play]]
+
+    set cur [$_movie get position cur]
+
+#    # this probably is incorrect because other people
+#    # could schedule stuff in the after queue
+#    if {[llength [after info]] > 1} {
+#        # drop frames that get caught up in the "after queue"
+#        # in order to keep up with the frame rate
+#        #foreach i [after info] {
+#        #    after cancel $i
+#        #}
+#        incr _waiting
+#    } else {
+#        # display the next frame
+#        $_imh put [$_movie seek +[incr _waiting]]
+#        set _waiting 0
+#
+#        # update the dial and framenum widgets
+#        set _settings($this-currenttime) [expr 1.0*$cur/${_lastFrame}]
+#        $itk_component(framenum) value $cur
+#
+#    }
+
+    # display the next frame
+    $_imh put [$_movie next]
+
+    # update the dial and framenum widgets
+    set _settings($this-currenttime) [expr 1.0*$cur/${_lastFrame}]
+    $itk_component(framenum) value $cur
+
+    if {[expr $cur%100] == 0} {
+        puts "after: [after info]"
+        puts "id = ${_id}"
+    }
+
+    # schedule the next frame to be displayed
+    if {$cur < ${_lastFrame}} {
+        set _id [after ${_mspf} [itcl::code $this Play]]
+    }
+}
+
+
+# ----------------------------------------------------------------------
+# Seek - go to a frame in the video video frame
+#   Seek -percent 43
+#   Seek -percent 0.5
+#   Seek +5
+#   Seek -5
+#   Seek 35
+#   Seek -currenttime
+#   Seek -framenum
+# ----------------------------------------------------------------------
+itcl::body Rappture::VideoViewer::Seek {args} {
+    set option [lindex $args 0]
+    switch -- $option {
+        "-percent" {
+            set val [lindex $args 1]
+            if {[string is integer -strict $val] == 1} {
+                set val [expr double($val) / 100.0]
+            }
+            # convert the percentage to a frame number (new cur)
+            set val [expr int($val * ${_lastFrame})]
+        }
+        "-currenttime" {
+            set val $_settings($this-currenttime)
+            set val [expr round($val * ${_lastFrame})]
+        }
+        "-framenum" {
+            set val [$itk_component(framenum) value]
+        }
+        default {
+            set val $option
+        }
+    }
+    if {"" == $val} {
+        error "bad value: \"$val\": should be \"seek \[-percent\] value\""
+    }
+    $_imh put [$_movie seek $val]
+    set cur [$_movie get position cur]
+    set _settings($this-currenttime) [expr double($cur) / double(${_lastFrame})]
 }
 
@@ -527 +727 @@
     set dist [Rappture::Units::convert [$itk_component(distGauge) value] -units off]
     set px2dist [expr $dist/$px]
-    if {$px2dist != $_px2dist} {
+    if {$px2dist != ${_px2dist}} {
         set _px2dist $px2dist
     }
 
-    # if the measure object exists?
-    foreach { x0 y0 x1 y1 } [$itk_component(main) bbox "measure"] break
-    set px [expr sqrt(pow(($x1-$x0),2)+pow(($y1-$y0),2))]
-    set dist [expr $px*$_px2dist]
-    $itk_component(measGauge) value $dist
+    # if measure lines exist, update their values
+    foreach tag ${_measTags} {
+        foreach { x0 y0 x1 y1 } [$itk_component(main) bbox $tag] break
+        set px [expr sqrt(pow(($x1-$x0),2)+pow(($y1-$y0),2))]
+        set dist [expr $px*${_px2dist}]
+        regexp {measure(\d+)} $tag match cnt
+        $itk_component(measGauge$cnt) value $dist
+    }
 }
 
@@ -548 +751 @@
         "new" {
             $win delete "distance"
-            $win delete "distance_val"
+            $win delete "distance-val"
             $win create line \
                 $x $y $x $y -fill red -width 2  \
@@ -567 +770 @@
                 -window $itk_component(distGauge) \
                 -anchor center \
-                -tags "distance_val"
+                -tags "distance-val"
         }
         default {
@@ -583 +786 @@
         "new" {
             $win delete "measure"
-            $win delete "measure_val"
             $win create line \
                 $x $y $x $y -fill green -width 2  \
@@ -593 +795 @@
         }
         "release" {
+            # finish drawing the measuring line
             Measure drag $win $x $y
+
+            # calculate the location on the measuring line to place gauge
             foreach { x0 y0 x1 y1 } [$itk_component(main) bbox "measure"] break
+            puts "bbox for $_measCnt is ($x0,$y0) ($x1,$y1)"
             set rootx [winfo rootx $itk_component(main)]
             set rooty [winfo rooty $itk_component(main)]
             set x [expr "$x0 + (abs($x1-$x0)/2)"]
             set y [expr "$y0 + (abs($y1-$y0)/2)"]
+
+#            set popup ".measure$_measCnt-popup"
+#            if { ![winfo exists $popup] } {
+#                # Create a popup for the measure line dialog
+#                Rappture::Balloon $popup -title "Configure measurement..."
+#                set inner [$popup component inner]
+#                # Create the print dialog widget and add it to the
+#                # the balloon popup.
+#                Rappture::XyPrint $inner.print-
+#                $popup configure \
+#                    -deactivatecommand [list $inner.print reset]-
+#                blt::table $inner 0,0 $inner.print -fill both
+#            }
+#
+#
+            # create a new gauge for this measuring line
+            itk_component add measGauge$_measCnt {
+                Rappture::Gauge $itk_interior.measGauge$_measCnt \
+                    -units "m"
+            } {
+                usual
+                rename -background -controlbackground controlBackground Background
+            }
+            Rappture::Tooltip::for $itk_component(measGauge$_measCnt) \
+                "Length of structure $_measCnt"
+
+            # place the gauge on the measuring line
             $itk_component(main) create window $x $y \
-                -window $itk_component(measGauge) \
+                -window $itk_component(measGauge$_measCnt) \
                 -anchor center \
-                -tags "measure_val"
+                -tags "measure$_measCnt-val"
+
+            # set the value of the gauge with the calculated distance
             set px [expr sqrt(pow(($x1-$x0),2)+pow(($y1-$y0),2))]
             set dist [expr $px*$_px2dist]
-            $itk_component(measGauge) value $dist
+            $itk_component(measGauge$_measCnt) value $dist
+
+            # rename the tag for the line
+            # so we can have multiple measure lines
+            # store tag name for future value updates
+            $itk_component(main) addtag "measure$_measCnt" withtag "measure"
+            $itk_component(main) dtag "measure" "measure"
+            lappend _measTags "measure$_measCnt"
+            incr _measCnt
         }
         default {
@@ -612 +855 @@
     }
 }
+
+# ----------------------------------------------------------------------
+# Particle - mark a particle in the video, a new particle object is
+#            created from information like the name, which video
+#            frames it lives in, it's coords in the canvas in each
+#            frame, it's color...
+# ----------------------------------------------------------------------
+itcl::body Rappture::VideoViewer::Particle {status win x y} {
+    switch -- $status {
+        "new" {
+            incr _pcnt
+            puts "pcnt = ${_pcnt}"
+            set name "particle${_pcnt}"
+            set p [Rappture::VideoParticle $itk_component(main).#auto $win \
+                    -fncallback [itcl::code $this video position cur] \
+                    -trajcallback [itcl::code $this Trajectory] \
+                    -halo 5 \
+                    -name $name \
+                    -color green]
+            set frameNum [$_movie get position cur]
+            $p Add frame $frameNum $x $y
+            $p Show particle
+
+            # link the new particle to the last particle added
+            set lastp ""
+            while {[llength ${_particles}] > 0} {
+                set lastp [lindex ${_particles} end]
+                if {[llength [$lastp Coords]] != 0} {
+                    break
+                } else {
+                    set _particles [lreplace ${_particles} end end]
+                    set lastp ""
+                }
+            }
+
+            if {[string compare "" $lastp] != 0} {
+                $lastp Link $p
+                bind $lastp <<Motion>> [itcl::code $lastp drawVectors]]
+            }
+
+
+            # add the particle to the list
+            lappend _particles $p
+
+            $win bind $name <ButtonPress-1> [itcl::code $p Move press %x %y]
+            $win bind $name <B1-Motion> [itcl::code $p Move motion %x %y]
+            $win bind $name <ButtonRelease-1> [itcl::code $p Move release %x %y]
+
+            $win bind $name <ButtonPress-3> [itcl::code $p Menu activate %x %y]
+
+            $win bind $name <Enter> [itcl::code $this togglePtrBind particle]
+            $win bind $name <Leave> [itcl::code $this togglePtrBind current]
+
+#            set pm [Rappture::VideoParticleManager]
+#            $pm add $p0
+#            set plist [$pm list]
+        }
+        default {
+            error "bad status \"$status\": should be new, drag, or release"
+        }
+    }
+}
+
+# ----------------------------------------------------------------------
+# Trajectory - draw a trajectory between two particles
+# ----------------------------------------------------------------------
+itcl::body Rappture::VideoViewer::Trajectory {args} {
+
+    set nargs [llength $args]
+    if {($nargs != 1) && ($nargs != 2)} {
+        error "wrong # args: should be \"Trajectory p0 p1\""
+    }
+
+    set p0 ""
+    set p1 ""
+    foreach {p0 p1} $args break
+
+    if {[string compare "" $p0] == 0} {
+        # p0 does not exist
+        return
+    }
+
+    # remove any old trajectory links from p0
+    set p0name [$p0 cget -name]
+    set oldlink "vec-$p0name"
+    puts "removing $oldlink"
+    $itk_component(main) delete $oldlink
+
+    # check to see if p1 exists anymore
+    if {[string compare "" $p1] == 0} {
+        # p1 does not exist
+        return
+    }
+
+    foreach {x0 y0} [$p0 Coords] break
+    foreach {x1 y1} [$p1 Coords] break
+    set p1name [$p1 cget -name]
+    set link "vec-$p0name-$p1name"
+    puts "adding $link"
+    $itk_component(main) create line $x0 $y0 $x1 $y1 \
+        -fill green \
+        -width 2 \
+        -tags "vector $link vec-$p0name" \
+        -dash {4 4} \
+        -arrow last
+
+    # calculate trajectory, truncate it after 4 sigdigs
+    puts "---------$link---------"
+    set t [calculateTrajectory [$p0 Frame] $x0 $y0 [$p1 Frame] $x1 $y1]
+    set tt [string range $t 0 [expr [string first . $t] + 4]]
+
+
+    # calculate coords for text
+    foreach { x0 y0 x1 y1 } [$itk_component(main) bbox $link] break
+    set x [expr "$x0 + (abs($x1-$x0)/2)"]
+    set y [expr "$y0 + (abs($y1-$y0)/2)"]
+
+    $itk_component(main) create text $x $y \
+        -tags "vectext $link vec-$p0name" \
+        -justify center \
+        -text "$tt [$itk_component(distGauge) cget -units]/s" \
+        -fill green \
+        -width [expr sqrt(pow(abs($x1-$x0),2)+pow(abs($y1-$y0),2))]
+}
+
+# ----------------------------------------------------------------------
+# calculateTrajectory - calculate the value of the trajectory
+# ----------------------------------------------------------------------
+itcl::body Rappture::VideoViewer::calculateTrajectory {args} {
+    # set framerate 29.97         ;# frames per second
+    # set px2dist    8.00         ;# px per meter
+
+    foreach {f0 x0 y0 f1 x1 y1} $args break
+    set px [expr sqrt(pow(abs($x1-$x0),2)+pow(abs($y1-$y0),2))]
+    set frames [expr $f1 - $f0]
+
+    if {($frames != 0) && (${_px2dist} != 0)} {
+        set t [expr 1.0*$px/$frames/${_px2dist}*${_framerate}]
+    } else {
+        set t 0.0
+    }
+
+    puts "px = $px"
+    puts "frames = $frames"
+    puts "px2dist = ${_px2dist}"
+    puts "framerate = ${_framerate}"
+    puts "trajectory = $t"
+
+    return $t
+}
+