Changeset 1916 for trunk/gui/scripts


Ignore:
Timestamp:
Oct 6, 2010, 6:58:50 AM (14 years ago)
Author:
dkearney
Message:

switching from RpMediaPlayer? to RpVideo? code for the video viewer widget. changed flowdial widget so the dial moved as needed for the video widget.

Location:
trunk/gui/scripts
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/Makefile.in

    r1886 r1916  
    112112                $(srcdir)/valueresult.tcl \
    113113                $(srcdir)/videoviewer.tcl \
     114                $(srcdir)/videoparticle.tcl \
    114115                $(srcdir)/visviewer.tcl \
    115116                $(srcdir)/xylegend.tcl \

  • trunk/gui/scripts/flowdial.tcl

    r1694 r1916  
    3636    itk_option define -max max Max ""
    3737    itk_option define -variable variable Variable ""
     38    itk_option define -offset offset Offset 1
    3839
    3940    itk_option define -thickness thickness Thickness 0
    … …  
    6768    protected method _fixSize {}
    6869    protected method _fixValue {args}
     70    protected method _fixOffsets {}
    6971
    7072    private method _current {value}
    … …  
    7981    private variable _activecolor ""  ;# width allocated for values
    8082    private variable _vwidth 0        ;# width allocated for values
     83    private variable _offset_pos 1    ;#
     84    private variable _offset_neg -1   ;#
    8185    public variable min 0.0
    8286    public variable max 1.0
    … …  
    97101    bind $itk_component(dial) <Configure> [itcl::code $this _redraw]
    98102
    99     if 0 {
     103#    if 0 {
    100104    bind $itk_component(dial) <ButtonPress-1> [itcl::code $this _click %x %y]
    101105    bind $itk_component(dial) <B1-Motion> [itcl::code $this _click %x %y]
    102106    bind $itk_component(dial) <ButtonRelease-1> [itcl::code $this _click %x %y]
    103     bind $itk_component(hull) <KeyPress-Left> [itcl::code $this _navigate -1]
    104     bind $itk_component(hull) <KeyPress-Right> [itcl::code $this _navigate 1]
     107    #bind $itk_component(hull) <KeyPress-Left> [itcl::code $this _navigate $_offset_neg]
     108    #bind $itk_component(hull) <KeyPress-Right> [itcl::code $this _navigate $_offset_pos]
     109
    105110    $itk_component(dial) bind  "knob" <Enter> \
    106111        [list $itk_component(dial) configure -cursor sb_h_double_arrow]
    107112    $itk_component(dial) bind  "knob" <Leave> \
    108113        [list $itk_component(dial) configure -cursor ""]
    109     }
     114#    }
    110115    eval itk_initialize $args
    111116
    112117    _fixSize
     118    _fixOffsets
    113119}
    114120
    … …  
    131137itcl::body Rappture::Flowdial::current {value} {
    132138    if {"" == $value} {
    133         return 
     139        return
    134140    }
    135141    _current [ms2rel $value]
    … …  
    148154    if { $relval < 0.0 } {
    149155        set relval 0.0
    150     } 
     156    }
    151157    if { $relval > 1.0 } {
    152158        set relval 1.0
    153     }                                       
     159    }
    154160    set _current $relval
    155161    after cancel [itcl::code $this _redraw]
    … …  
    328334# clients.
    329335# ----------------------------------------------------------------------
     336#itcl::body Rappture::Flowdial::_navigate {offset} {
     337#    set index [lsearch -exact $_values $_current]
     338#    if {$index >= 0} {
     339#        incr index $offset
     340#        if {$index >= [llength $_values]} {
     341#            set index [expr {[llength $_values]-1}]
     342#        } elseif {$index < 0} {
     343#            set index 0
     344#        }
     345#
     346#        set newval [lindex $_values $index]
     347#        if {$newval != $_current} {
     348#            current $newval
     349#            _redraw
     350#
     351#            event generate $itk_component(hull) <<Value>>
     352#        }
     353#    }
     354#}
     355
     356
     357# ----------------------------------------------------------------------
     358# USAGE: _navigate <offset>
     359#
     360# Called automatically whenever the user presses left/right keys
     361# to nudge the current value left or right by some <offset>.  If the
     362# value actually changes, it generates a <<Value>> event to notify
     363# clients.
     364# ----------------------------------------------------------------------
    330365itcl::body Rappture::Flowdial::_navigate {offset} {
    331     set index [lsearch -exact $_values $_current]
    332     if {$index >= 0} {
    333         incr index $offset
    334         if {$index >= [llength $_values]} {
    335             set index [expr {[llength $_values]-1}]
    336         } elseif {$index < 0} {
    337             set index 0
    338         }
    339 
    340         set newval [lindex $_values $index]
    341         if {$newval != $_current} {
    342             current $newval
    343             _redraw
    344 
    345             event generate $itk_component(hull) <<Value>>
    346         }
    347     }
     366    _current [ms2rel [expr $_current + $offset]]
     367    event generate $itk_component(hull) <<Value>>
    348368}
    349369
    … …  
    414434    upvar #0 $itk_option(-variable) var
    415435    _current [ms2rel $var]
     436}
     437
     438# ----------------------------------------------------------------------
     439# USAGE: _fixOffsets
     440#
     441# ----------------------------------------------------------------------
     442itcl::body Rappture::Flowdial::_fixOffsets {} {
     443    if {0 == $itk_option(-offset)} {
     444        return
     445    }
     446    set _offset_pos $itk_option(-offset)
     447    set _offset_neg [expr -1*$_offset_pos]
     448    bind $itk_component(hull) <KeyPress-Left> [itcl::code $this _navigate $_offset_neg]
     449    bind $itk_component(hull) <KeyPress-Right> [itcl::code $this _navigate $_offset_pos]
    416450}
    417451
    … …  
    590624    }
    591625}
     626
     627# ----------------------------------------------------------------------
     628# CONFIGURE: -offset
     629# ----------------------------------------------------------------------
     630itcl::configbody Rappture::Flowdial::offset {
     631    if {![string is double $itk_option(-offset)]} {
     632        error "bad value \"$itk_option(-offset)\": should be >= 0.0"
     633    }
     634    _fixOffsets
     635}

  • trunk/gui/scripts/resources.tcl

    r1342 r1916  
    2828    variable optionParser [interp create -safe]
    2929    foreach cmd [$optionParser eval {info commands}] {
    30         $optionParser hide $cmd
     30        $optionParser hide $cmd
    3131    }
    3232    # this lets us ignore unrecognized commands in the file:
    … …  
    4545    variable optionParser
    4646    foreach {name proc} $args {
    47         $optionParser alias $name $proc
     47        $optionParser alias $name $proc
    4848    }
    4949}
    … …  
    7171    global auto_index
    7272    foreach name [array names auto_index *_init_resources] {
    73         eval $name
     73        eval $name
    7474    }
    7575
    … …  
    8080    #
    8181    if {[info exists env(SESSIONDIR)]} {
    82         set file $env(SESSIONDIR)/resources
    83         if {![file exists $file]} {
    84             return 0
    85         }
     82        set file $env(SESSIONDIR)/resources
     83        if {![file exists $file]} {
     84            return 0
     85        }
    8686
    87         if {[catch {
    88             set fid [open $file r]
    89             set info [read $fid]
    90             close $fid
    91             $optionParser eval $info
    92         } result]} {
    93             if {"" != $callback} {
    94                 after 1 [list $callback -title Error -icon error -message "Error in resources file:\n$result"]
    95             }
    96             return 0
    97         }
     87        if {[catch {
     88            set fid [open $file r]
     89            set info [read $fid]
     90            close $fid
     91            $optionParser eval $info
     92        } result]} {
     93            if {"" != $callback} {
     94                after 1 [list $callback -title Error -icon error -message "Error in resources file:\n$result"]
     95            }
     96            return 0
     97        }
    9898    }
    9999    return 1

  • trunk/gui/scripts/videoviewer.tcl

    r1886 r1916  
    4545    public method video {args}
    4646
     47    protected method togglePtrBind {pbvar}
    4748    protected method togglePtrCtrl {pbvar}
    48     protected method togglePtrBind {pbvar}
     49    protected method whatPtrCtrl {}
    4950
    5051    protected method Play {}
     52    protected method Seek {n}
    5153    protected method Rubberband {status win x y}
    5254    protected method Distance {status win x y}
    5355    protected method Measure {status win x y}
     56    protected method Particle {status win x y}
     57    protected method Trajectory {args}
    5458    protected method updateMeasurements {}
     59    protected method calculateTrajectory {args}
    5560
    5661    private common   _settings
    … …  
    6267    private variable _units "m"
    6368    private variable _movie ""      ;# movie we grab images from
     69    private variable _lastFrame 0   ;# last frame in the movie
    6470    private variable _imh ""        ;# current image being displayed
    6571    private variable _id ""         ;# id of the next play command from after
    6672    private variable _pbvlist ""    ;# list of push button variables
    6773    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
    6881}
    6982
    … …  
    8194        $this-arrows            0
    8295        $this-currenttime       0
     96        $this-framenum          0
    8397        $this-duration          1:00
    8498        $this-loop              0
    … …  
    179193
    180194
     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
    181212    blt::table $itk_component(pointercontrols) \
    182213        0,0 $itk_component(rectangle) -pady {3 0} \
    183214        0,1 $itk_component(distance) -pady {3 0} \
    184         0,2 $itk_component(measure) -pady {3 0}
     215        0,2 $itk_component(measure) -pady {3 0} \
     216        0,3 $itk_component(particle) -pady {3 0}
    185217
    186218    blt::table configure $itk_component(pointercontrols) c* -resize none
    … …  
    195227            -borderwidth 1 -padx 1 -pady 1 \
    196228            -image [Rappture::icon flow-rewind] \
    197             -command [itcl::code $this video reset]
     229            -command [itcl::code $this video seek 0]
    198230    } {
    199231        usual
    … …  
    255287    }
    256288    $itk_component(dial) current 0.0
    257     bind $itk_component(dial) <<Value>> [itcl::code $this flow goto]
     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
    258307    # Duration
    259308    itk_component add duration {
    … …  
    303352
    304353    $itk_component(speed) value 1
    305     bind $itk_component(speed) <<Value>> [itcl::code $this flow speed]
     354    bind $itk_component(speed) <<Value>> [itcl::code $this video speed]
    306355
    307356
    … …  
    312361        0,3 $itk_component(loop) -padx {2 0} \
    313362        0,4 $itk_component(dial) -fill x -padx {2 0 } \
    314         0,5 $itk_component(duration) -padx { 0 0} \
     363        0,5 $itk_component(framenum) -padx { 0 0} \
     364        0,6 $itk_component(duration) -padx { 0 0} \
    315365        0,7 $itk_component(speed) -padx {2 3}
    316366
    … …  
    327377    }
    328378    Rappture::Tooltip::for $itk_component(distGauge) \
    329         "Length of structure"
    330 
    331     itk_component add measGauge {
    332         Rappture::Gauge $itk_interior.measGauge \
    333             -units "m"
    334     } {
    335         usual
    336         rename -background -controlbackground controlBackground Background
    337     }
    338     Rappture::Tooltip::for $itk_component(measGauge) \
    339379        "Length of structure"
    340380
    … …  
    359399# ----------------------------------------------------------------------
    360400itcl::body Rappture::VideoViewer::load {filename} {
    361     set _movie [Rappture::MediaPlayer $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}"
    362407
    363408    set _imh [image create photo]
    364     $_imh put [$_movie read]
     409    $_imh put [$_movie next]
    365410    $itk_component(main) create image 0 0 -anchor nw -image $_imh
    366411
     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
    367430    $itk_component(main) configure -scrollregion [$itk_component(main) bbox all]
    368431    foreach { x0 y0 x1 y1 } [$itk_component(main) bbox all] break
    369432    set w [expr abs($x1-$x0)]
    370     set h [expr abs($y1-$y0)]
    371     $itk_component(main) configure -width $w -height $h
     433    set h [expr abs($y1-$y0+$pch+$mch)]
     434    # $itk_component(main) configure -width $w -height $h
    372435    .main configure -width $w -height $h
    373436
    … …  
    378441# ----------------------------------------------------------------------
    379442itcl::body Rappture::VideoViewer::video { args } {
     443    set ret 0
    380444    set option [lindex $args 0]
    381445    switch -- $option {
    382446        "play" {
    383447            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>> ""
    384451                # start playing
    385452                Play
    … …  
    388455                after cancel $_id
    389456                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]
    390461            }
    391462        }
    392463        "seek" {
     464            Seek [lreplace $args 0 0]
    393465        }
    394466        "stop" {
    … …  
    396468            set _settings($this-play) 0
    397469        }
     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        }
    398477        default {
    399             error "bad option \"$option\": should be play, stop, toggle, or reset."
    400         }
    401     }
     478            error "bad option \"$option\": should be play, stop, toggle, position, or reset."
     479        }
     480    }
     481    return $ret
    402482}
    403483
    404484# ----------------------------------------------------------------------
    405485# togglePtrCtrl - choose pointer mode:
    406 #                 rectangle, distance, or measure
     486#                 rectangle, distance, measure, particlemark
    407487# ----------------------------------------------------------------------
    408488itcl::body Rappture::VideoViewer::togglePtrCtrl {pbvar} {
    409489
    410490    upvar 1 $pbvar inState
    411 
     491    puts "togglePtrCtrl to $pbvar"
    412492    if {$inState == 1} {
    413493        # unpush previously pushed buttons
    … …  
    424504
    425505# ----------------------------------------------------------------------
     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# ----------------------------------------------------------------------
    426520# togglePtrBind - update the bindings based on pointer controls
    427521# ----------------------------------------------------------------------
    428522itcl::body Rappture::VideoViewer::togglePtrBind {pbvar} {
    429523
     524    if {[string compare $pbvar current] == 0} {
     525        set pbvar [whatPtrCtrl]
     526    }
     527
    430528    if {[string compare $pbvar rectPbVar] == 0} {
    431529
    432530        # Bindings for selecting rectangle
     531        $itk_component(main) configure -cursor ""
     532
    433533        bind $itk_component(main) <ButtonPress-1> \
    434534            [itcl::code $this Rubberband new %W %x %y]
    … …  
    441541
    442542        # Bindings for setting distance
     543        $itk_component(main) configure -cursor ""
     544
    443545        bind $itk_component(main) <ButtonPress-1> \
    444546            [itcl::code $this Distance new %W %x %y]
    … …  
    451553
    452554        # Bindings for measuring distance
     555        $itk_component(main) configure -cursor ""
     556
    453557        bind $itk_component(main) <ButtonPress-1> \
    454558            [itcl::code $this Measure new %W %x %y]
    … …  
    458562            [itcl::code $this Measure release %W %x %y]
    459563
     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
    460583    } else {
    461584
    … …  
    463586
    464587    }
    465 
    466588}
    467589
    … …  
    471593# ----------------------------------------------------------------------
    472594itcl::body Rappture::VideoViewer::Play {} {
    473     $_imh put [$_movie read]
    474     set _id [after 20 [itcl::code $this 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})]
    475675}
    476676
    … …  
    527727    set dist [Rappture::Units::convert [$itk_component(distGauge) value] -units off]
    528728    set px2dist [expr $dist/$px]
    529     if {$px2dist != $_px2dist} {
     729    if {$px2dist != ${_px2dist}} {
    530730        set _px2dist $px2dist
    531731    }
    532732
    533     # if the measure object exists?
    534     foreach { x0 y0 x1 y1 } [$itk_component(main) bbox "measure"] break
    535     set px [expr sqrt(pow(($x1-$x0),2)+pow(($y1-$y0),2))]
    536     set dist [expr $px*$_px2dist]
    537     $itk_component(measGauge) value $dist
     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    }
    538741}
    539742
    … …  
    548751        "new" {
    549752            $win delete "distance"
    550             $win delete "distance_val"
     753            $win delete "distance-val"
    551754            $win create line \
    552755                $x $y $x $y -fill red -width 2  \
    … …  
    567770                -window $itk_component(distGauge) \
    568771                -anchor center \
    569                 -tags "distance_val"
     772                -tags "distance-val"
    570773        }
    571774        default {
    … …  
    583786        "new" {
    584787            $win delete "measure"
    585             $win delete "measure_val"
    586788            $win create line \
    587789                $x $y $x $y -fill green -width 2  \
    … …  
    593795        }
    594796        "release" {
     797            # finish drawing the measuring line
    595798            Measure drag $win $x $y
     799
     800            # calculate the location on the measuring line to place gauge
    596801            foreach { x0 y0 x1 y1 } [$itk_component(main) bbox "measure"] break
     802            puts "bbox for $_measCnt is ($x0,$y0) ($x1,$y1)"
    597803            set rootx [winfo rootx $itk_component(main)]
    598804            set rooty [winfo rooty $itk_component(main)]
    599805            set x [expr "$x0 + (abs($x1-$x0)/2)"]
    600806            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
    601834            $itk_component(main) create window $x $y \
    602                 -window $itk_component(measGauge) \
     835                -window $itk_component(measGauge$_measCnt) \
    603836                -anchor center \
    604                 -tags "measure_val"
     837                -tags "measure$_measCnt-val"
     838
     839            # set the value of the gauge with the calculated distance
    605840            set px [expr sqrt(pow(($x1-$x0),2)+pow(($y1-$y0),2))]
    606841            set dist [expr $px*$_px2dist]
    607             $itk_component(measGauge) value $dist
     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
    608851        }
    609852        default {
    … …  
    612855    }
    613856}
     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 TracChangeset for help on using the changeset viewer.