Changeset 2028

Timestamp:

Jan 12, 2011 10:04:22 PM (13 years ago)

Author:

dkearney

Message:

video widget updates
various bug fixes

Location:

trunk

Files:

• examples/video/piv/piv.tcl (modified) (1 diff)
• gui/scripts/flowdial.tcl (modified) (2 diffs)
• gui/scripts/pushbutton.tcl (modified) (1 diff)
• gui/scripts/videodial2.tcl (modified) (28 diffs)
• gui/scripts/videodistance.tcl (modified) (1 diff)
• gui/scripts/videoparticle.tcl (modified) (1 diff)
• gui/scripts/videopreview.tcl (modified) (5 diffs)
• gui/scripts/videoscreen.tcl (modified) (41 diffs)
• lang/tcl/src/RpVideoTclInterface.cc (modified) (2 diffs)
• src/objects/RpVideo.c (modified) (1 diff)
• src/objects/RpVideo.h (modified) (1 diff)

trunk/examples/video/piv/piv.tcl

@@ -38 +38 @@
 wm withdraw .
 set width 960
-set height 625
+set height 630
 
 set installdir [file dirname [ \

trunk/gui/scripts/flowdial.tcl

@@ -61 +61 @@
     public method clear {}
     public method color {value}
-                                                                                
+
     protected method _redraw {}
     protected method _click {x y}
@@ -82 +82 @@
     public variable max 1.0
 }
-                                                                                
+
 itk::usual Flowdial {
     keep -background -foreground -cursor -font

trunk/gui/scripts/pushbutton.tcl

@@ -80 +80 @@
 itcl::body Rappture::PushButton::invoke {} {
     if { !$_enabled } {
-        puts "in invoke button not enabled"
         return
     }

trunk/gui/scripts/videodial2.tcl

@@ -59 +59 @@
     protected method _fixOffsets {}
 
+    private method _calculateDialDimensions {}
+    private method _calculateDisplayRange {args}
+    private method _drawDial {disp_min disp_max}
+    private method _getFramenumFromId {id}
+    private method _nearestFrameMarker {x y}
     private method _current {value}
     private method _see {item}
@@ -64 +69 @@
     private method ms2rel {value}
     private method rel2ms {value}
+
     private common _click             ;# x,y point where user clicked
     private common _marks             ;# list of marks
+    private common _dd                ;# holds the dimensions of the dial
     private variable _values ""       ;# list of all values on the dial
     private variable _val2label       ;# maps value => string label(s)
@@ -77 +84 @@
     private variable _minortick 1
     private variable _majortick 5
+    private variable _lockdial 0
+    private variable _displayMin 0
+    private variable _displayMax 0
 }
 
@@ -100 +110 @@
     bind $itk_component(minordial) <Configure> [itcl::code $this _redraw]
 
-    bind $itk_component(minordial) <ButtonPress-1> [itcl::code $this _move click %x %y]
-    bind $itk_component(minordial) <B1-Motion> [itcl::code $this _move drag %x %y]
-    bind $itk_component(minordial) <ButtonRelease-1> [itcl::code $this _move release %x %y]
+    _bindings timeline
 
     # ----------------------------------------------------------------------
@@ -118 +126 @@
 
     $itk_component(minordial) configure -background cyan
-
-    #$itk_component(minordial) configure -relief sunken -borderwidth 1
 
     _fixOffsets
@@ -144 +150 @@
         return
     }
+
+    if {$value < ${_min}} {
+        set value ${_min}
+    }
+
+    if {$value > ${_max}} {
+        set value ${_max}
+    }
+
     _current [ms2rel $value]
-    # event generate $itk_component(hull) <<Value>>
 }
 
@@ -157 +171 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::Videodial2::_current {relval} {
+
+    if {[string is double $relval] == 0} {
+        error "bad value \"$relval\": expected relval to be a double"
+    }
+    if {${_current} == $relval} {
+        # nothing to do
+        return
+    }
+
     if { $relval < 0.0 } {
         set relval 0.0
@@ -163 +186 @@
         set relval 1.0
     }
+
     set _current $relval
-    _redraw
-
-    # update the current marker and move the canvas so current is centered
     set framenum [expr round([rel2ms $_current])]
-    after idle [itcl::code $this _see "frame$framenum"]
-    after idle [_setmark current $framenum]
+
+    set updated 0
+    if {${_lockdial} == 1} {
+        # the dial is "locked" this means we don't center the dial
+        # on the current value. we only move the dial if the
+        # current value is less than or greater than the marks alredy
+        # shown on the dial.
+        if {[expr ${_displayMin}+${_majortick}] >= $framenum} {
+            set newdmin [expr $framenum-${_majortick}]
+            foreach {dmin dmax} [_calculateDisplayRange -min $newdmin] break
+            incr updated
+        } elseif {[expr ${_displayMax}-${_majortick}] <= $framenum} {
+            set newdmax [expr $framenum+${_majortick}]
+            foreach {dmin dmax} [_calculateDisplayRange -max $newdmax] break
+            incr updated
+        }
+    } else {
+        # center the current marker
+        foreach {dmin dmax} [_calculateDisplayRange] break
+        incr updated
+    }
+
+    if {$updated == 1} {
+        _drawDial $dmin $dmax
+    }
+
+    after idle [_setmark currentmark $framenum]
 
     # update the upvar variable
@@ -178 +224 @@
 }
 
+
+# ----------------------------------------------------------------------
+# USAGE: _centerCurrentMark <type> ?args?
+# ----------------------------------------------------------------------
+itcl::body Rappture::Videodial2::_bindings {type args} {
+
+}
+
 # ----------------------------------------------------------------------
 # USAGE: _bindings <type> ?args?
-#
 # ----------------------------------------------------------------------
 itcl::body Rappture::Videodial2::_bindings {type args} {
@@ -189 +242 @@
             bind $itk_component(minordial) <B1-Motion> [itcl::code $this _marker $tag drag %x %y]
             bind $itk_component(minordial) <ButtonRelease-1> [itcl::code $this _marker $tag release %x %y]
-            $itk_component(minordial) configure -cursor hand2
+            $itk_component(minordial) configure -cursor sb_h_double_arrow
         }
         "timeline" {
-            bind $itk_component(minordial) <ButtonPress-1> [itcl::code $this _move click %x %y]
-            bind $itk_component(minordial) <B1-Motion> [itcl::code $this _move drag %x %y]
-            bind $itk_component(minordial) <ButtonRelease-1> [itcl::code $this _move release %x %y]
+            # bind $itk_component(minordial) <ButtonPress-1> [itcl::code $this _move click %x %y]
+            # bind $itk_component(minordial) <B1-Motion> [itcl::code $this _move drag %x %y]
+            # bind $itk_component(minordial) <ButtonRelease-1> [itcl::code $this _move release %x %y]
+            bind $itk_component(minordial) <ButtonPress-1> { }
+            bind $itk_component(minordial) <B1-Motion> { }
+            bind $itk_component(minordial) <ButtonRelease-1> { }
             $itk_component(minordial) configure -cursor ""
         }
@@ -240 +296 @@
 
 # ----------------------------------------------------------------------
+# USAGE: _getFramenumFromId <id>
+# ----------------------------------------------------------------------
+itcl::body Rappture::Videodial2::_getFramenumFromId {id} {
+    set where 0
+
+    # find the frame# tag to associate with the marker with
+    if {[regexp {frame([0-9]+)} $id] == 0} {
+        foreach tags [$c gettags $id] {
+            if {"" != [set tmp [lsearch -inline -regexp $tags {frame[0-9]+}]]} {
+                set where $tmp
+                break
+            }
+        }
+    } else {
+        set where $id
+    }
+    # store the frame number in where
+    regexp {frame([0-9]+)} $where match where
+
+    # restrict <where> to valid frames between min and max
+    if {$where < ${_min}} {
+        set where ${_min}
+    }
+    if {$where > ${_max}} {
+        set where ${_max}
+    }
+
+    return $where
+}
+
+# ----------------------------------------------------------------------
 # USAGE: _setmark <type> ?[-xcoord|-tag]? <where>
 #
 # Clients use this to add a mark to the timeline
-#   type can be any one of loopstart, loopend, particle, measure
+#   type can be any of loopstart, loopend, particle, measure, currentmark
 #   where is interpreted based on the preceeding flag if available.
 #       in the default case, <where> is interpreted as a frame number
@@ -307 +394 @@
             "-tag" {
                 set id [lindex $args 1]
-                # find the frame# tag to associate with the marker with
-                if {[regexp {frame([0-9]+)} $id] == 0} {
-                    foreach tags [$c gettags $id] {
-                        if {"" != [set tmp [lsearch -inline -regexp $tags {frame[0-9]+}]]} {
-                            set where $tmp
-                            break
-                        }
-                    }
-                } else {
-                    set where $id
-                }
-                # store the frame number in where
-                regexp {frame([0-9]+)} $where match where
-
-                # restrict <where> to valid frames between min and max
-                if {$where < ${_min}} {
-                    set where ${_min}
-                }
-                if {$where > ${_max}} {
-                    set where ${_max}
-                }
-
+                set where [_getFramenumFromId $id]
                 foreach {frx0 fry0 frx1 fry1} [$c coords frame$where] break
             }
@@ -375 +441 @@
                 $smx4 $smy4 \
                 $smx5 $smy5 \
-                -outline black -fill black -tags $tag
+                -outline black -fill black -tags [list $tag dialval]
 
             $c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
@@ -418 +484 @@
                 $emx4 $emy4 \
                 $emx5 $emy5 \
-                -outline black -fill black -tags $tag
+                -outline black -fill black -tags [list $tag dialval]
 
             $c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
@@ -434 +500 @@
                 }
             }
-
         }
         "particle*" {
@@ -444 +509 @@
 
             set tag $type
+            $c delete $tag
             $c create oval $coords \
                 -fill green \
                 -outline black \
                 -width 1 \
-                -tags $tag
+                -tags [list $tag dialval]
 
             #$c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
@@ -456 +522 @@
                 set _marks($type) $where
             }
-
-
         }
         "measure*" {
@@ -467 +531 @@
 
             set tag $type
+            $c delete $tag
             $c create line $coords \
                 -fill red \
                 -width 3  \
-                -tags $tag
+                -tags [list $tag dialval]
 
             #$c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
@@ -478 +543 @@
                 set _marks($type) $where
             }
-
-        }
-        "current" {
+        }
+        "currentmark" {
 
             set cmx0 $frx0                              ;# current marker x0
@@ -502 +566 @@
                 $cmx3 $cmy3 \
                 $cmx4 $cmy4 \
-                -outline black -fill red -tags $tag
-            $c create line $cmx0 $cmy0 $cmx0 $cy1 -fill red -tags $tag
-
-            #$c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
-            #$c bind $tag <Leave> [itcl::code $this _bindings timeline]
+                -outline black \
+                -fill red \
+                -tags [list $tag dialval]
+            $c create line $cmx0 $cmy0 $cmx0 $cy1 \
+                -fill red \
+                -tags [list $tag dialval]
+
+            $c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
+            $c bind $tag <Leave> [itcl::code $this _bindings timeline]
 
             if {[string compare "" $where] != 0} {
                 set _marks($type) $where
             }
-
         }
         default {
@@ -524 +591 @@
 #   debug function to print out the bounding box information for
 #   minor dial
-#
 # ----------------------------------------------------------------------
 itcl::body Rappture::Videodial2::bball {} {
@@ -541 +607 @@
 }
 
-itcl::body Rappture::Videodial2::_redraw {args} {
-
-    set disp_min 0
-    set disp_max 0
-
-    if {[llength $args] == 2} {
-        foreach {disp_min disp_max} $args break
-
-        if {[string is integer $disp_min] != 1} {
-            error "bad value \"$disp_min\": should be an integer"
-        }
-        if {($disp_min < ${_min}) || ($disp_min > ${_max})} {
-            error "bad value \"$disp_min\": should be between ${_min} and ${_max}"
-        }
-
-        if {[string is integer $disp_max] != 1} {
-            error "bad value \"$disp_max\": should be an integer"
-        }
-        if {($disp_max < ${_min}) || ($disp_max > ${_max})} {
-            error "bad value \"$disp_max\": should be between ${_min} and ${_max}"
-        }
-
-        if {$disp_min > $disp_max} {
-            set tmp $disp_min
-            set disp_min $disp_max
-            set disp_max $tmp
-        }
-
-    } elseif {[llength $args] != 0} {
-        error "wrong # args: should be \"_redraw ?<disp_min> <disp_max>?\""
-    }
-
-
+# ----------------------------------------------------------------------
+# USAGE: _calculateDisplayRange
+#   calculate the minimum and maximum values to display on the dial
+# ----------------------------------------------------------------------
+itcl::body Rappture::Videodial2::_calculateDisplayRange {args} {
+
+    Rappture::getopts args params {
+        value -min 0
+        value -max 0
+    }
+
+    set disp_min $params(-min)
+    set disp_max $params(-max)
+
+    if {($disp_min == 0) && ($disp_max == 0)} {
+        # calculate the display min and max by
+        # centering the current value on the dial
+        set framenum [expr round([rel2ms ${_current}])]
+        set disp_min [expr ($framenum-$_dd(ni))]
+        set disp_max [expr ($framenum+$_dd(ni))]
+    } elseif {($disp_min != 0) && ($disp_max == 0)} {
+        # user supplied disp_min value
+        # calculate disp_max
+        set disp_max [expr round($disp_min+($_dd(ni)*2.0))]
+    } elseif {($disp_min == 0) && ($disp_max != 0)} {
+        # user supplied disp_max value
+        # calculate disp_min
+        set disp_min [expr round($disp_max-($_dd(ni)*2.0))]
+    }
+
+    # deal with edge cases
+
+    if {($disp_min < ${_min})} {
+        # don't display marks less than ${_min}
+        set disp_min ${_min}
+        set disp_max [expr round(${_min}+($_dd(ni)*2.0))]
+        if {$disp_max > ${_max}} {
+            set disp_max ${_max}
+        }
+    }
+
+    if {($disp_max > ${_max})} {
+        # don't display marks greater than ${_max}
+        set disp_min [expr round(${_max}-($_dd(ni)*2.0))]
+        if {$disp_min < ${_min}} {
+            set disp_min ${_min}
+        }
+        set disp_max ${_max}
+    }
+
+    return [list $disp_min $disp_max]
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _calculateDialDimensions
+#   calculate dimensions used to draw the dial
+# ----------------------------------------------------------------------
+itcl::body Rappture::Videodial2::_calculateDialDimensions {} {
     set c $itk_component(minordial)
-    $c delete all
-
-    set fg $itk_option(-foreground)
-
     set w [winfo width $c]
     set h [winfo height $c]
@@ -589 +676 @@
 
 
+    # add intermediate marks between markers
+    set imw 1.0                                 ;# intermediate mark width
+
+    set imsh [expr {$t/3.0}]                    ;# intermediate mark short height
+    set imsy0 [expr {$y0+(($t-$imsh)/2.0)}]     ;# precalc'd imark short y0 coord
+    set imsy1 [expr {$imsy0+$imsh}]             ;# precalc'd imark short y1 coord
+
+    set imlh [expr {$t*2.0/3.0}]                ;# intermediate mark long height
+    set imly0 [expr {$y0+(($t-$imlh)/2.0)}]     ;# precalc'd imark long y0 coord
+    set imly1 [expr {$imly0+$imlh}]             ;# precalc'd imark long y1 coord
+
+    set imty [expr {$y0-5}]                     ;# height of marker value
+
+    set x [expr ($x1-$x0)/2.0]
+    set ni [expr int(($x-$x0)/${_imspace})]
+
+    set _dd(x0) $x0
+    set _dd(y0) $y0
+    set _dd(x1) $x1
+    set _dd(y1) $y1
+    set _dd(ni) $ni
+    set _dd(imly0) $imly0
+    set _dd(imly1) $imly1
+    set _dd(imw) $imw
+    set _dd(imty) $imty
+    set _dd(imsy0) $imsy0
+    set _dd(imsy1) $imsy1
+
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _redraw
+#   calculate dimensions, display range, and draw the dial, again
+# ----------------------------------------------------------------------
+itcl::body Rappture::Videodial2::_redraw {args} {
+
+    _calculateDialDimensions
+
+    foreach {disp_min disp_max} [_calculateDisplayRange] break
+
+    set c $itk_component(minordial)
+    $c delete all
+
     # draw the background rectangle for the minor time line
-    $c create rectangle $x0 $y0 $x1 $y1 \
+    $c create rectangle $_dd(x0) $_dd(y0) $_dd(x1) $_dd(y1) \
         -outline $itk_option(-dialoutlinecolor) \
         -fill $itk_option(-dialfillcolor) \
         -tags "imbox"
 
-    # add intermediate marks between markers
-    set imw 1.0                                 ;# intermediate mark width
-
-    set imsh [expr {$t/3.0}]                    ;# intermediate mark short height
-    set imsy0 [expr {$y0+(($t-$imsh)/2.0)}]     ;# precalc'd imark short y0 coord
-    set imsy1 [expr {$imsy0+$imsh}]             ;# precalc'd imark short y1 coord
-
-    set imlh [expr {$t*2.0/3.0}]                ;# intermediate mark long height
-    set imly0 [expr {$y0+(($t-$imlh)/2.0)}]     ;# precalc'd imark long y0 coord
-    set imly1 [expr {$imly0+$imlh}]             ;# precalc'd imark long y1 coord
-
-    set imty [expr {$y0-5}]                     ;# height of marker value
-
-    set imx $x0
-
-    if {($disp_min == 0) && ($disp_max == 0)} {
-        set x [expr ($x1-$x0)/2.0]
-        set ni [expr ($x-$x0)/${_imspace}]
-
-        set framenum [expr round([rel2ms ${_current}])]
-
-        set disp_min [expr ($framenum-$ni)]
-        set disp_max [expr ($framenum+$ni)]
-
-        # deal with edge cases
-        if {($disp_min < ${_min})} {
-            # don't display marks less than ${_min}
-            set disp_min ${_min}
-            set disp_max [expr (${_min}+($ni*2.0))]
-            if {$disp_max > ${_max}} {
-                set disp_max ${_max}
-            }
-        }
-
-        if {($disp_max > ${_max})} {
-            # don't display marks greater than ${_max}
-            set disp_min [expr (${_max}-($ni*2.0))]
-            if {$disp_min < ${_min}} {
-                set disp_min ${_min}
-            }
-            set disp_max ${_max}
-        }
-    }
-
-    for {set i [expr {int($disp_min)}]} {$i <= $disp_max} {incr i} {
-        if {($i%${_majortick}) == 0} {
-            # draw major tick
-            $c create line $imx $imly0 $imx $imly1 \
-                -fill red \
-                -width $imw \
-                -tags [list longmark-c imark-c "frame$i"]
-
-            $c create text $imx $imty -anchor center -text $i \
-                -font $itk_option(-font) -tags "frame$i"
-
-            set imx [expr $imx+${_imspace}]
-        } elseif {($i%${_minortick}) == 0 } {
-            # draw minor tick
-            $c create line $imx $imsy0 $imx $imsy1 \
-                -fill blue \
-                -width $imw \
-                -tags [list shortmark-c imark-c "frame$i"]
-
-            set imx [expr $imx+${_imspace}]
-        }
-    }
-
+    _drawDial $disp_min $disp_max
 
     # calculate the height of the intermediate tick marks
@@ -672 +736 @@
     $c coords "imbox" $box
 
-    # add an invisible box 15 pixels above and 20 pixels below imbox
+    # add an invisible box 20 pixels above and below imbox
     # to keep the canvas from changing sizes when the we add
     # particle, loopstart, loopend, and line markers
     foreach {x0 y0 x1 y1} $box break
-    $c create rectangle $x0 [expr $y0-15] $x1 [expr $y1+20] \
+    $c create rectangle $x0 [expr $y0-20] $x1 [expr $y1+20] \
         -outline "" \
         -fill "" \
         -tags "markerbox"
 
+    # re-add any marks that the user previously specified
+    # do it again because we changed the size of imbox
+    foreach n [array names _marks] {
+        if {($_marks($n) > ${_displayMin}) && ($_marks($n) < ${_displayMax})} {
+            _setmark $n $_marks($n)
+        }
+    }
+
+    _fixSize
+}
+
+
+# ----------------------------------------------------------------------
+# USAGE: _drawDial
+#   draw the dial
+# ----------------------------------------------------------------------
+itcl::body Rappture::Videodial2::_drawDial {dmin dmax} {
+    set c $itk_component(minordial)
+    $c delete dialval
+
+    set _displayMin [expr int($dmin)]
+    set _displayMax [expr int($dmax)]
+
+    set imx [expr $_dd(x0)+5]
+    for {set i ${_displayMin}} {$i <= ${_displayMax}} {incr i} {
+        if {($i%${_majortick}) == 0} {
+            # draw major tick
+            $c create line $imx $_dd(imly0) $imx $_dd(imly1) \
+                -fill red \
+                -width $_dd(imw) \
+                -tags [list dialval longmark imark "frame$i"]
+
+            $c create text $imx $_dd(imty) \
+                -anchor center \
+                -text $i \
+                -font $itk_option(-font) \
+                -tags [list dialval frame$i frame$i-text]
+
+            set imx [expr $imx+${_imspace}]
+        } elseif {($i%${_minortick}) == 0 } {
+            # draw minor tick
+            $c create line $imx $_dd(imsy0) $imx $_dd(imsy1) \
+                -fill blue \
+                -width $_dd(imw) \
+                -tags [list dialval shortmark imark "frame$i"]
+
+            set imx [expr $imx+${_imspace}]
+        }
+    }
+
+    if {(${_displayMin}%${_majortick}) == 0} {
+        # first tick is numbered, delete the text if
+        # it shows up outside of our desired imbox
+        foreach {dmx0 dmy0 dmx1 dmy1} [$c bbox frame${_displayMin}-text] break
+        # need to check for if dmx0 exists because there
+        # are some cases when the widget is first being
+        # created where _calculateDisplayRange gives
+        # back bad values, dmin > dmax.
+        if {[info exists dmx0] && ($dmx0 < $_dd(x0))} {
+            $c delete frame${_displayMin}-text
+        }
+    }
+    if {(${_displayMax}%${_majortick}) == 0} {
+        # last tick is numbered, delete the text if
+        # it shows up outside of our desired imbox
+        foreach {dmx0 dmy0 dmx1 dmy1} [$c bbox frame${_displayMax}-text] break
+        # need to check for if dmx1 exists because there
+        # are some cases when the widget is first being
+        # created where _calculateDisplayRange gives
+        # back bad values, dmin > dmax.
+        if {[info exists dmx1] && ($dmx1 > $_dd(x1))} {
+            $c delete frame${_displayMax}-text
+        }
+    }
+
     # add any marks that the user previously specified
     foreach n [array names _marks] {
-        if {($_marks($n) > $disp_min) && ($_marks($n) < $disp_max)} {
+        if {($_marks($n) > ${_displayMin}) && ($_marks($n) < ${_displayMax})} {
             _setmark $n $_marks($n)
         }
     }
-
-    _fixSize
 }
 
@@ -732 +869 @@
 
 # ----------------------------------------------------------------------
+# USAGE: _nearestFrameMarker <x> <y>
+#
+# Called automatically whenever the user clicks or drags on a marker
+# widget.  Moves the selected marker to the next nearest tick mark.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Videodial2::_nearestFrameMarker {x y} {
+
+    set c $itk_component(minordial)
+
+    foreach {junk y0 junk y1} [$c bbox "imark"] break
+    set id ""
+    # FIXME:
+    # the amount added to _imspace should be 1
+    # but for some reason the dial is slightly shifted
+    # on the canvas by 2 or 3 pixels. so we have to
+    # add a larger value like 3 to _imspace to find
+    # the next frame marker
+    set x0 [expr {$x-round((${_imspace}+3)/2.0)}]
+    set x1 [expr {$x+round((${_imspace}+3)/2.0)}]
+
+    #$c delete scrap
+    #$c create rectangle $x0 $y0 $x1 $y1 \
+        -outline green -tags "scrap"
+
+    foreach item [$c find enclosed $x0 $y0 $x1 $y1] {
+        set itemtags [$c gettags $item]
+
+        foreach {x00 junk x11 junk} [$c bbox $item] break
+
+        if {[lsearch -exact $itemtags "imark"] != -1} {
+            set id [lsearch -inline -regexp $itemtags {frame[0-9]}]
+            break
+        }
+    }
+    if {[string compare "" $id] == 0} {
+        # something went wrong
+        # we should have found an imark with
+        # an associated "frame#" tag to snap to
+        # bailout
+        #error "could not find an intermediate mark to snap marker to"
+        puts stderr "could not find an intermediate mark to snap marker to"
+    }
+
+    return $id
+
+}
+
+# ----------------------------------------------------------------------
 # USAGE: _marker <tag> click <x> <y>
 #        _marker <tag> drag <x> <y>
@@ -741 +926 @@
 itcl::body Rappture::Videodial2::_marker {tag action x y} {
     set c $itk_component(minordial)
-    set x [_offsetx $x]
     switch $action {
         "click" {
+            if {"currentmark" == $tag} {
+                set _lockdial 1
+            }
         }
         "drag" {
-            _setmark $tag -xcoord $x
-            # if we are too close to the edge, scroll the canvas.
-            # $c xview scroll $dist "unit"
+            set x [_offsetx $x]
+
+            # as the marker passes over frame marks, snap to the closest frame mark
+            set id [_nearestFrameMarker $x $y]
+            if {"" == $id} {
+                return
+            }
+
+            if {"currentmark" == $tag} {
+                # update the current frame shown on the screen
+                # this doesn't quite work yet, i think because
+                # the seek requests are buffered until the gui
+                # is idle
+                set newfn [_getFramenumFromId $id]
+                set oldfn [expr round([rel2ms ${_current}])]
+                if {$newfn != $oldfn} {
+                    _current [ms2rel $newfn]
+                    event generate $itk_component(hull) <<Value>>
+                }
+            } else {
+                _setmark $tag -tag $id
+            }
         }
         "release" {
-            # on release, snap to the closest imark
-            foreach {junk y0 junk y1} [$c bbox "imark-c"] break
-            set id ""
-            foreach item [$c find enclosed [expr {$x-((${_imspace}+1)/2.0)}] $y0 \
-                                           [expr {$x+((${_imspace}+1)/2.0)}] $y1] {
-                set itemtags [$c gettags $item]
-                if {[lsearch -exact $itemtags "imark-c"] != -1} {
-                    set id [lsearch -inline -regexp $itemtags {frame[0-9]}]
-                    break
-                }
-            }
-            if {[string compare "" $id] == 0} {
-                # something went wrong
-                # we should have found an imark with
-                # an associated "frame#" tag to snap to
-                # bailout
-                error "could not find an intermediate mark to snap marker to"
-            }
-
-            _setmark $tag -tag $id
+
+            _marker $tag drag $x $y
+
+            if {"currentmark" == $tag} {
+                set _lockdial 0
+            }
 
             # take care of cases where the mouse leaves the marker's boundries
@@ -777 +969 @@
             # generate the "Leave" event.
             set leave 1
+            set x [_offsetx $x]
             foreach item [$c find overlapping $x $y $x $y] {
                 if {[lsearch -exact [$c gettags $item] $tag] != -1} {
@@ -788 +981 @@
                 # event generate $c <Leave>
                 _bindings timeline
-            }
-            if {"current" == $tag} {
-                # if we move the current marker, update the frame number
-                current [mark position current]
-                event generate $itk_component(hull) <<Value>>
             }
         }

trunk/gui/scripts/videodistance.tcl

@@ -200 +200 @@
             error "bad value: \"$val\": frame number should be an integer"
         }
+
         set _frame $val
 

trunk/gui/scripts/videoparticle.tcl

@@ -408 +408 @@
             error "bad value: \"$val\": frame number should be an integer"
         }
+
         set _frame $val
 
         if {"" != $itk_option(-onframe)} {
             uplevel \#0 $itk_option(-onframe) ${_frame}
+        }
+
+        drawVectors
+        if {[string compare "" ${_prevnode}] != 0} {
+            ${_prevnode} drawVectors
         }
     } elseif {[llength $args] != 0} {

trunk/gui/scripts/videopreview.tcl

@@ -122 +122 @@
             -onimage [Rappture::icon flow-pause] \
             -offimage [Rappture::icon flow-play] \
+            -disabledimage [Rappture::icon flow-play] \
             -variable [itcl::scope _settings($this-play)] \
             -command [itcl::code $this video play]
@@ -128 +129 @@
     Rappture::Tooltip::for $itk_component(play) \
         "Play/Pause movie"
+    $itk_component(play) disable
 
     # Video Dial Major
@@ -193 +195 @@
 
     $itk_component(main) configure -background black
-    puts "width = [$itk_component(main) cget -width]"
-    puts "height = [$itk_component(main) cget -height]"
 }
 
@@ -269 +269 @@
     # update the dial with video information
     $itk_component(dialmajor) configure -min 0 -max ${_lastFrame}
+    $itk_component(play) enable
 
     fixSize
@@ -351 +352 @@
     # make the canvas fit the image
     $itk_component(main) configure -width ${_width} -height ${_height}
-    puts "bbox = [$itk_component(main) bbox all]"
 }
 

trunk/gui/scripts/videoscreen.tcl

@@ -60 +60 @@
     private method calculateTrajectory {args}
     private method writeText {x y text color tags width}
+    private method clearDrawings {}
 
     # video dial tools
@@ -66 +67 @@
     private common   _settings
     private common   _pendings
+    private common   _pbvars
+    private common   _counters
 
     private variable _width -1      ;# start x for rubberbanding
@@ -78 +81 @@
                                     ;# underlying c lib in milliseconds
     private variable _delay  0      ;# milliseconds between play calls
-    private variable _waiting 0     ;# number of frames behind we are
     private variable _nextframe 0   ;#
 
-    private variable _pbvlist ""    ;# list of the pushbutton variables
-    private variable _pcnt 0        ;# counter for naming particles
+    private variable _px2dist 0     ;# conversion for pixels to user specified distance
     private variable _particles ""  ;# list of particles
-    private variable _px2dist 0     ;# conversion for pixels to user specified distance
-    private variable _measTags ""   ;# tags of measurement lines
-    private variable _measCnt 0     ;# counter for naming measure lines
+    private variable _measurements "" ;# list of all measurement lines
     private variable _obj ""        ;# temp var holding the last created object
 }
@@ -102 +101 @@
 
     array set _settings [subst {
-        $this-framenum          0
-        $this-loop              0
-        $this-play              0
-        $this-speed             1
+        framenum          0
+        loop              0
+        play              0
+        speed             1
     }]
 
-    array set _pendings [subst {
+    array set _pendings {
         seek 0
         play 0
-    }]
-
+    }
+
+    array set _counters {
+        particle 0
+        measure 0
+    }
 
     # Create flow controls...
@@ -153 +156 @@
             -image [Rappture::icon upload] \
             -command [itcl::code $this loadcb]
-            #-command [Rappture::filexfer::upload {piv tool} {id label desc} [itcl::code $this Upload]]
-            #-command [itcl::code $this video seek 0]
-    } {
-        usual
-        ignore -borderwidth
-        rename -highlightbackground -controlbackground controlBackground \
-            Background
+    } {
+        usual
     }
     Rappture::Tooltip::for $itk_component(fileopen) \
@@ -170 +168 @@
             -onimage $measImg \
             -offimage $measImg \
-            -command [itcl::code $this togglePtrCtrl measPbVar] \
-            -variable measPbVar
-    } {
-        usual
-    }
+            -disabledimage $measImg \
+            -command [itcl::code $this togglePtrCtrl "measure"] \
+            -variable [itcl::scope _pbvars(measure)]
+    } {
+        usual
+    }
+    $itk_component(measure) disable
     Rappture::Tooltip::for $itk_component(measure) \
         "Measure the distance of a structure"
-    lappend _pbvlist measPbVar
 
     # ==== particle mark tool ====
@@ -183 +182 @@
     itk_component add particle {
         Rappture::PushButton $itk_component(moviecontrols).particlepb \
-           -onimage $particleImg \
+            -onimage $particleImg \
             -offimage $particleImg \
-            -command [itcl::code $this togglePtrCtrl partPbVar] \
-            -variable partPbVar
-    } {
-        usual
-    }
+            -disabledimage $particleImg \
+            -command [itcl::code $this togglePtrCtrl "particle"] \
+            -variable [itcl::scope _pbvars(particle)]
+    } {
+        usual
+    }
+    $itk_component(particle) disable
     Rappture::Tooltip::for $itk_component(particle) \
         "Mark the location of a particle to follow"
-    lappend _pbvlist partPbVar
 
 
@@ -207 +207 @@
             Background
     }
+    $itk_component(rewind) configure -state disabled
     Rappture::Tooltip::for $itk_component(rewind) \
         "Rewind movie"
@@ -222 +223 @@
             Background
     }
+    $itk_component(seekback) configure -state disabled
     Rappture::Tooltip::for $itk_component(rewind) \
         "Seek backwards 1 frame"
@@ -230 +232 @@
             -onimage [Rappture::icon flow-pause] \
             -offimage [Rappture::icon flow-play] \
-            -variable [itcl::scope _settings($this-play)] \
+            -disabledimage [Rappture::icon flow-play] \
+            -variable [itcl::scope _settings(play)] \
             -command [itcl::code $this video play]
     }
-    set fg [option get $itk_component(hull) font Font]
+    $itk_component(play) disable
     Rappture::Tooltip::for $itk_component(play) \
         "Play/Pause movie"
@@ -249 +252 @@
             Background
     }
+    $itk_component(seekforward) configure -state disabled
     Rappture::Tooltip::for $itk_component(seekforward) \
         "Seek forward 1 frame"
@@ -257 +261 @@
             -onimage [Rappture::icon flow-loop] \
             -offimage [Rappture::icon flow-loop] \
-            -variable [itcl::scope _settings($this-loop)] \
+            -disabledimage [Rappture::icon flow-loop] \
+            -variable [itcl::scope _settings(loop)] \
             -command [itcl::code $this toggleloop]
     }
+    $itk_component(loop) disable
     Rappture::Tooltip::for $itk_component(loop) \
         "Play continuously between marked sections"
@@ -276 +282 @@
             -linecolor "" -activelinecolor "" \
             -min 0 -max 1 \
-            -variable [itcl::scope _settings($this-framenum)] \
+            -variable [itcl::scope _settings(framenum)] \
             -dialoutlinecolor black \
             -knobimage [Rappture::icon knob2] -knobposition center@middle
@@ -293 +299 @@
             -min 0 -max 1 \
             -minortick 1 -majortick 5 \
-            -variable [itcl::scope _settings($this-framenum)] \
+            -variable [itcl::scope _settings(framenum)] \
             -dialoutlinecolor black
     } {
@@ -301 +307 @@
     $itk_component(dialminor) current 0
     bind $itk_component(dialminor) <<Value>> [itcl::code $this video update]
+
+    set fg [option get $itk_component(hull) font Font]
 
     itk_component add framenumlabel {
@@ -315 +323 @@
         label $itk_component(frnumfr).framenum \
             -background white -font "arial 9" \
-            -textvariable [itcl::scope _settings($this-framenum)]
+            -textvariable [itcl::scope _settings(framenum)]
     } {
         usual
@@ -357 +365 @@
         0,0 $itk_component(dialmajor) -fill x \
         1,0 $itk_component(dialminor) -fill x
-
 
     blt::table $itk_component(moviecontrols) \
@@ -391 +398 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::VideoScreen::destructor {} {
-    array unset _settings $this-*
+    array unset _settings *
+    array unset _pendings *
+    array unset _pbvars *
+    array unset _counters *
+
+
     if {[info exists _imh]} {
-        image delete $_imh
+        image delete ${_imh}
+        set _imh ""
+    }
+
+    if {[info exists measImg]} {
+        image delete $measImg
+        set measImg ""
+    }
+
+    if {[info exists particleImg]} {
+        image delete $particleImg
+        set particleImg ""
+    }
+
+    if {("" != [info commands ${_movie}])} {
+        # clear the movie if it is still open
+        ${_movie} release
+        set _movie ""
+    }
+
+    clearDrawings
+}
+
+# ----------------------------------------------------------------------
+# clearDrawings - delete all particle and measurement objects
+# ----------------------------------------------------------------------
+itcl::body Rappture::VideoScreen::clearDrawings {} {
+
+    # delete all previously placed particles
+    set obj [lindex ${_particles} end]
+    while {"" != [info commands $obj]} {
+        itcl::delete object $obj
+        set _particles [lreplace ${_particles} end end]
+        if {[llength ${_particles}] == 0} {
+            break
+        }
+        set obj [lindex ${_particles} end]
+    }
+
+    # delete all previously placed measurements
+    set obj [lindex ${_measurements} end]
+    while {"" != [info commands $obj]} {
+        itcl::delete object $obj
+        set _measurements [lreplace ${_measurements} end end]
+        if {[llength ${_measurements}] == 0} {
+            break
+        }
+        set obj [lindex ${_measurements} end]
     }
 }
@@ -408 +467 @@
 
     # open the file
-
     set fname ""
     switch $type {
         "data" {
+            if {"" == $data} {
+                error "bad value \"$data\": data should be a movie"
+            }
+
             set fname "/tmp/tmpVV[pid].video"
             set fid [open $fname "w"]
@@ -421 +483 @@
         }
         "file" {
+            if {"" == $data} {
+                error "bad value \"$data\": data should be a movie file path"
+            }
             # do nothing
         }
@@ -430 +495 @@
     video stop
 
-    if {([info exists _movie]) && ("" != ${_movie})} {
-        ${_movie} release
+    if {"file" == $type} {
+        if {("" != [info commands ${_movie}])} {
+            # compare the new file name to the name of the file
+            # we already have open in our _movie object.
+            # if they are the same, do not reopen the video.
+            # if they are different, close the old movie
+            # and clear out all old drawings from the canvas.
+            set err [catch {${_movie} get filename} filename]
+            if {($err == 0)&& ($data == $filename)} {
+                # video file already open, don't reopen it.
+                return
+            } else {
+                # clear the old movie
+                ${_movie} release
+
+                # delete drawings objects from canvas
+                clearDrawings
+            }
+        }
     }
 
     set _movie [Rappture::Video $type $data]
-    file delete $fname
+    if {"" != $fname} {
+        file delete $fname
+    }
     set _framerate [${_movie} get framerate]
     video speed
@@ -442 +526 @@
 
     # update the dial and framenum widgets
-    set _settings($this-framenum) 0
+    set _settings(framenum) 0
 
 
@@ -460 +544 @@
     $itk_component(dialmajor) configure -min 0 -max ${_lastFrame}
     $itk_component(dialminor) configure -min 0 -max ${_lastFrame}
+
+    # turn on the buttons and dials
+    $itk_component(measure) enable
+    $itk_component(particle) enable
+    $itk_component(rewind) configure -state normal
+    $itk_component(seekback) configure -state normal
+    $itk_component(play) enable
+    $itk_component(seekforward) configure -state normal
+    $itk_component(loop) enable
 
     fixSize
@@ -531 +624 @@
     switch -- $option {
         "play" {
-            if {$_settings($this-play) == 1} {
+            if {$_settings(play) == 1} {
                 eventually play
             } else {
@@ -537 +630 @@
                 after cancel $_id
                 set _pendings(play) 0
-                set _settings($this-play) 0
+                set _settings(play) 0
             }
         }
@@ -545 +638 @@
         "stop" {
             after cancel $_id
-            set _settings($this-play) 0
+            set _settings(play) 0
         }
         "speed" {
@@ -554 +647 @@
         }
         "update" {
-            eventually seek [expr round($_settings($this-framenum))]
-            # Seek [expr round($_settings($this-framenum))]
+            eventually seek [expr round($_settings(framenum))]
+            # Seek [expr round($_settings(framenum))]
         }
         default {
@@ -618 +711 @@
 
     # update the dial and framenum widgets
-    set _settings($this-framenum) $cur
+    set _settings(framenum) $cur
 
 
@@ -626 +719 @@
     # if looping is turned on and markers setup,
     # then loop back to loopstart when cur hits loopend
-    if {$_settings($this-loop)} {
+    if {$_settings(loop)} {
         if {$cur == [$itk_component(dialminor) mark position loopend]} {
             Seek [$itk_component(dialminor) mark position loopstart]
@@ -657 +750 @@
     if {[string compare $cur $val] == 0} {
         # already at the frame to seek to
+        set _pendings(seek) 0
         return
     }
@@ -663 +757 @@
 
     # update the dial and framenum widgets
-    set _settings($this-framenum) [$_movie get position cur]
+    set _settings(framenum) [$_movie get position cur]
     event generate $itk_component(main) <<Frame>>
 
+    # removing pending
+    set _pendings(seek) 0
 }
 
@@ -678 +774 @@
     switch -- $option {
         "seek" {
-            if {$_pendings(seek) == 0} {
+            if {0 == $_pendings(seek)} {
                 # no seek pending, schedule one
-                set $_pendings(seek) 1
+                set _pendings(seek) 1
                 after idle [itcl::code $this Seek [lindex $args 1]]
             } else {
@@ -707 +803 @@
 #                 rectangle, measure, particlemark
 # ----------------------------------------------------------------------
-itcl::body Rappture::VideoScreen::togglePtrCtrl {pbvar} {
-
-    upvar 1 $pbvar inState
-    if {$inState == 1} {
+itcl::body Rappture::VideoScreen::togglePtrCtrl {tool} {
+
+    if {[info exists _pbvars($tool)] == 0} {
+        return
+    }
+
+    if {$_pbvars($tool) == 1} {
         # unpush previously pushed buttons
-        foreach pbv $_pbvlist {
-            if {[string compare $pbvar $pbv] != 0} {
-                upvar 1 $pbv var
-                set var 0
-            }
-        }
-    }
-    togglePtrBind $pbvar
+        foreach pbv [array names _pbvars] {
+            if {[string compare $tool $pbv] != 0} {
+                set _pbvars($pbv) 0
+            }
+        }
+    }
+    togglePtrBind $tool
 }
 
@@ -728 +826 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::VideoScreen::whatPtrCtrl {} {
-    foreach pbv $_pbvlist {
-        upvar #0 $pbv var
-        if {$var != "" && $var != 0} {
+    foreach pbv [array names _pbvars] {
+        if {$_pbvars($pbv) != 0} {
             return $pbv
         }
@@ -746 +843 @@
     }
 
-    if {[string compare $pbvar rectPbVar] == 0} {
+    if {[string compare $pbvar rectangle] == 0} {
 
         # Bindings for selecting rectangle
@@ -758 +855 @@
             [itcl::code $this Rubberband release %W %x %y]
 
-    } elseif {[string compare $pbvar measPbVar] == 0} {
+    } elseif {[string compare $pbvar measure] == 0} {
 
         # Bindings for measuring distance
@@ -770 +867 @@
             [itcl::code $this Measure release %W %x %y]
 
-    } elseif {[string compare $pbvar partPbVar] == 0} {
+    } elseif {[string compare $pbvar particle] == 0} {
 
         # Bindings for marking particle locations
@@ -858 +955 @@
     switch -- $status {
         "new" {
-            incr _measCnt
-            set name "measure${_measCnt}"
-            lappend _measTags $name
+            set name "measure[incr _counters(measure)]"
 
             set _obj [Rappture::VideoDistance $itk_component(main).$name $name $win \
@@ -875 +970 @@
             ${_obj} Coords $x $y $x $y
             ${_obj} Show object
+            lappend _measurements ${_obj}
         }
         "drag" {
@@ -923 +1019 @@
     switch -- $status {
         "new" {
-            incr _pcnt
-            set name "particle${_pcnt}"
+            set name "particle[incr _counters(particle)]"
             set _obj [Rappture::VideoParticle $itk_component(main).$name $name $win \
                         -fncallback [itcl::code $this query framenum] \
@@ -1115 +1210 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::VideoScreen::toggleloop {} {
-    if {$_settings($this-loop) == 0} {
+    if {$_settings(loop) == 0} {
         $itk_component(dialminor) mark remove loopstart
         $itk_component(dialminor) mark remove loopend

trunk/lang/tcl/src/RpVideoTclInterface.cc

@@ -137 +137 @@
  * get image ?width height?
  * get framerate
+ * get filename
  *
  */
@@ -218 +219 @@
         Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fr));
     }
+    else if ((*info == 'f') && (strcmp(info,"filename") == 0)) {
+        if (objc != 3) {
+            Tcl_AppendResult(interp, "wrong # args: should be \"", cmd,
+                " filename\"", (char*)NULL);
+            return TCL_ERROR;
+        }
+
+        const char *fname = NULL;
+        int err = 0;
+
+        err = VideoGetFileName((VideoObj *)clientData, &fname);
+        if (err) {
+            Tcl_AppendResult(interp, "error while retrieving filename",
+                (char*)NULL);
+            return TCL_ERROR;
+        }
+        Tcl_AppendResult(interp, fname, (char*)NULL);
+    }
     else {
         Tcl_AppendResult(interp, "unrecognized command \"", info, "\": should be \"", cmd,

trunk/src/objects/RpVideo.c

@@ -1155 +1155 @@
 
 int
+VideoGetFileName (vidPtr, fname)
+    VideoObj *vidPtr;
+    const char **fname;
+{
+    AVStream *vstreamPtr;
+
+    if (vidPtr == NULL) {
+        return -1;
+    }
+
+    if (fname == NULL) {
+        return -1;
+    }
+
+    if (vidPtr->pFormatCtx == NULL) {
+        // vidPtr->pFormatCtx is NULL, video not open
+        return -1;
+    }
+
+    *fname = vidPtr->fileName;
+
+    return 0;
+}
+
+int
 VideoAllocImgBuffer(vidPtr, width, height)
     VideoObj *vidPtr;

trunk/src/objects/RpVideo.h

@@ -32 +32 @@
 int VideoGetPositionEnd (VideoObj *vidPtr, int *pos);
 int VideoGetFrameRate (VideoObj *vidPtr, double *fr);
+int VideoGetFileName (VideoObj *vidPtr, const char **fname);
 // static int VideoPutCmd (ClientData clientData,
 //     Tcl_Interp  *interp, int argc, CONST84 char *argv[]);