source: branches/1.4/gui/scripts/videoparticle.tcl @ 4941

Last change on this file since 4941 was 3330, checked in by gah, 12 years ago

merge (by hand) with Rappture1.2 branch
File size: 21.1 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: videoparticle - mark a particle on a video frame
4#
5# ======================================================================
6#  AUTHOR:  Derrick Kearney, Purdue University
7#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
8#
9# See the file "license.terms" for information on usage and redistribution of
10# this file, and for a DISCLAIMER OF ALL WARRANTIES.
11# ======================================================================
12package require Itk
13package require BLT
14package require Img
15package require Rappture
16package require RapptureGUI
17
18itcl::class Rappture::VideoParticle {
19    inherit itk::Widget
20
21    itk_option define -halo halo Halo "10"
22    itk_option define -color color Color "green"
23    itk_option define -fncallback fncallback Fncallback ""
24    itk_option define -bindentercb bindentercb Bindentercb ""
25    itk_option define -bindleavecb bindleavecb Bindleavecb ""
26    itk_option define -trajcallback trajcallback Trajcallback ""
27    itk_option define -px2dist px2dist Px2dist ""
28    itk_option define -units units Units "m/s"
29    itk_option define -bindings bindings Bindings "enable"
30    itk_option define -ondelete ondelete Ondelete ""
31    itk_option define -onframe onframe Onframe ""
32    itk_option define -framerange framerange Framerange ""
33
34    constructor { name win args } {
35        # defined below
36    }
37    destructor {
38        # defined below
39    }
40
41    public method Show {args}
42    public method Hide {args}
43    public method Link {args}
44    public method Coords {args}
45    public method Frame {args}
46    public method drawVectors {}
47    public method next {args}
48    public method prev {args}
49    public method name {}
50
51    public variable  fncallback ""      ;# framenumber callback - tells what frame we are on
52    public variable  bindentercb ""     ;# enter binding callback - call this when entering the object
53    public variable  bindleavecb ""     ;# leave binding callback - call this when leaving the object
54    public variable  trajcallback ""    ;# trajectory callback - calculates and draws trajectory
55
56    public method Move {status x y}
57    public method Menu {args}
58
59    protected method Enter {}
60    protected method Leave {}
61    protected method CatchEvent {event}
62
63    protected method _fixValue {args}
64    protected method _fixPx2Dist {px2dist}
65    protected method _fixBindings {status}
66
67    private variable _canvas        ""  ;# canvas which owns the particle
68    private variable _name          ""  ;# id of the particle
69    private variable _color         ""  ;# color of the particle
70    private variable _frame          0  ;# frame number where this object lives
71    private variable _coords        ""  ;# list of coords where the object lives
72    private variable _halo           0  ;# about the diameter of the particle
73    private variable _x              0  ;# x coord when "pressed" for motion
74    private variable _y              0  ;# y coord when "pressed" for motion
75    private variable _nextnode      ""  ;# particle this particle points to
76    private variable _prevnode      ""  ;# particle this particle is pointed to by
77    private variable _link          ""  ;# tag of vector linking this and nextnode
78    private variable _units         ""  ;#
79    private variable _px2dist       ""  ;# variable associated with -px2dist
80}
81
82itk::usual VideoParticle {
83    keep -background -foreground -cursor -font
84    keep -plotbackground -plotforeground
85}
86
87# ----------------------------------------------------------------------
88# CONSTRUCTOR
89# ----------------------------------------------------------------------
90itcl::body Rappture::VideoParticle::constructor {name win args} {
91
92    set _name $name
93    set _canvas $win
94
95    # setup the particle control menu
96    itk_component add menu {
97        Rappture::Balloon $itk_interior.particlecontrols -title "Particle Controls"
98    }
99
100    set controls [$itk_component(menu) component inner]
101
102    # Frame number control
103    label $controls.framenuml -text "Frame" -font "Arial 9"\
104         -highlightthickness 0
105    Rappture::Spinint $controls.framenume \
106        -min 0 -width 5 -font "arial 9"
107
108    # Delete control
109    label $controls.deletel -text "Delete" -font "Arial 9" \
110        -highlightthickness 0
111    Rappture::Switch $controls.deleteb -showtext "false"
112    $controls.deleteb value false
113
114    # Save button
115    button $controls.saveb -text Save \
116        -relief raised -pady 0 -padx 0  -font "Arial 9" \
117        -command [itcl::code $this Menu deactivate save] \
118        -activebackground grey90
119
120    # Cancel button
121    button $controls.cancelb -text Cancel \
122        -relief raised -pady 0 -padx 0  -font "Arial 9" \
123        -command [itcl::code $this Menu deactivate cancel] \
124        -activebackground grey90
125
126
127    grid $controls.framenuml -column 0 -row 0 -sticky e
128    grid $controls.framenume -column 1 -row 0 -sticky w
129    grid $controls.deletel   -column 0 -row 1 -sticky e
130    grid $controls.deleteb   -column 1 -row 1 -sticky w
131    grid $controls.saveb     -column 0 -row 2 -sticky e
132    grid $controls.cancelb   -column 1 -row 2 -sticky w
133
134
135    grid columnconfigure $controls 0 -weight 1
136
137    # finish configuring the particle
138    eval itk_initialize $args
139
140    # set the frame for the particle
141    Frame [uplevel \#0 $fncallback]
142    bind ${_name}-FrameEvent <<Frame>> [itcl::code $this CatchEvent Frame]
143}
144
145# ----------------------------------------------------------------------
146# DESTRUCTOR
147# ----------------------------------------------------------------------
148itcl::body Rappture::VideoParticle::destructor {} {
149    configure -px2dist ""  ;# remove variable trace
150
151    Hide object
152
153    # delete the vectors originating from this particle
154    if {[string compare "" ${_nextnode}] != 0} {
155        ${_canvas} delete ${_link}
156        ${_nextnode} prev ${_prevnode}
157    }
158
159    # delete the vectors pointing to this particle
160    if {[string compare "" ${_prevnode}] != 0} {
161        ${_prevnode} next ${_nextnode}
162        ${_prevnode} drawVectors
163    }
164
165    _fixBindings disable
166
167    if {"" != $itk_option(-ondelete)} {
168        uplevel \#0 $itk_option(-ondelete)
169    }
170}
171
172# ----------------------------------------------------------------------
173#   Enter - bindings if the mouse enters the object's space
174# ----------------------------------------------------------------------
175itcl::body Rappture::VideoParticle::Enter {} {
176    uplevel \#0 $bindentercb
177}
178
179
180# ----------------------------------------------------------------------
181#   Leave - bindings if the mouse leaves the object's space
182# ----------------------------------------------------------------------
183itcl::body Rappture::VideoParticle::Leave {} {
184    uplevel \#0 $bindleavecb
185}
186
187
188# ----------------------------------------------------------------------
189#   CatchEvent - bindings for caught events
190# ----------------------------------------------------------------------
191itcl::body Rappture::VideoParticle::CatchEvent {event} {
192    switch -- $event {
193        "Frame" {
194            if {[uplevel \#0 $fncallback] == ${_frame}} {
195                ${_canvas} itemconfigure ${_name}-particle -fill red
196            } else {
197                ${_canvas} itemconfigure ${_name}-particle -fill ${_color}
198            }
199        }
200        default {
201            error "bad event \"$event\": should be one of Frame."
202        }
203
204    }
205}
206
207
208# ----------------------------------------------------------------------
209# Show - draw the particle
210#   particle - draw the particle on the canvas
211#   name - popup a ballon with the name of this object
212# ----------------------------------------------------------------------
213itcl::body Rappture::VideoParticle::Show {args} {
214    set option [lindex $args 0]
215    switch -- $option {
216        "object" {
217            foreach {x y} ${_coords} break
218            set coords [list [expr $x-${_halo}] [expr $y-${_halo}] \
219                             [expr $x+${_halo}] [expr $y+${_halo}]]
220            ${_canvas} create oval $coords \
221                -fill ${_color} \
222                -width 0 \
223                -tags "particle ${_name} ${_name}-particle"
224        }
225        "name" {
226
227        }
228        default {
229            error "bad option \"$option\": should be one of object, name."
230        }
231    }
232}
233
234# ----------------------------------------------------------------------
235# Hide
236#   particle - remove the particle from where it is drawn
237#   name - remove the popup with the name
238# ----------------------------------------------------------------------
239itcl::body Rappture::VideoParticle::Hide {args} {
240    set option [lindex $args 0]
241    switch -- $option {
242        "object" {
243            if {[llength $args] != 1} {
244                error "wrong # args: should be \"particle\""
245            }
246            ${_canvas} delete "${_name}"
247        }
248        "name" {
249
250        }
251        default {
252            error "bad option \"$option\": should be one of object, name."
253        }
254    }
255}
256
257# ----------------------------------------------------------------------
258# Move - move the object to a new location
259# ----------------------------------------------------------------------
260itcl::body Rappture::VideoParticle::Move {status x y} {
261    switch -- $status {
262        "press" {
263            set _x $x
264            set _y $y
265        }
266        "motion" {
267            ${_canvas} move ${_name} [expr $x-${_x}] [expr $y-${_y}]
268            foreach {x0 y0 x1 y1} [${_canvas} coords ${_name}-particle] break
269            set _coords [list [expr $x0+${_halo}] [expr $y0+${_halo}]]
270            set _x $x
271            set _y $y
272            drawVectors
273            if {[string compare "" ${_prevnode}] != 0} {
274                ${_prevnode} drawVectors
275            }
276        }
277        "release" {
278        }
279        default {
280            error "bad option \"$option\": should be one of press, motion, release."
281        }
282    }
283}
284
285# ----------------------------------------------------------------------
286# Menu - popup a menu with the particle controls
287#   create
288#   activate x y
289#   deactivate status
290# ----------------------------------------------------------------------
291itcl::body Rappture::VideoParticle::Menu {args} {
292    set option [lindex $args 0]
293    switch -- $option {
294        "activate" {
295            if {[llength $args] != 3} {
296                error "wrong # args: should be \"activate <x> <y>\""
297            }
298            foreach {x y} [lrange $args 1 end] break
299            set dir "left"
300            set x0 [winfo rootx ${_canvas}]
301            set y0 [winfo rooty ${_canvas}]
302            set w0 [winfo width ${_canvas}]
303            set h0 [winfo height ${_canvas}]
304            set x [expr $x0+$x]
305            set y [expr $y0+$y]
306            $itk_component(menu) activate @$x,$y $dir
307
308            # update the values in the menu
309            set controls [$itk_component(menu) component inner]
310            $controls.framenume value ${_frame}
311            $controls.deleteb value false
312        }
313        "deactivate" {
314            $itk_component(menu) deactivate
315            if {[llength $args] != 2} {
316                error "wrong # args: should be \"deactivate <status>\""
317            }
318            set status [lindex $args 1]
319            switch -- $status {
320                "save" {
321                    set controls [$itk_component(menu) component inner]
322
323                    set newframenum [$controls.framenume value]
324                    if {${_frame} != $newframenum} {
325                        Frame $newframenum
326                    }
327
328                    if {[$controls.deleteb value]} {
329                        itcl::delete object $this
330                    }
331                }
332                "cancel" {
333                }
334                "default" {
335                    error "bad value \"$status\": should be one of save, cancel"
336                }
337            }
338        }
339        default {
340            error "bad option \"$option\": should be one of activate, deactivate."
341        }
342    }
343}
344
345# ----------------------------------------------------------------------
346# Link - move the particle to a new location
347# ----------------------------------------------------------------------
348itcl::body Rappture::VideoParticle::Link {args} {
349    # add a new particle list of linked particles
350    foreach {p} $args break
351    $p prev $this
352    next $p
353    drawVectors
354}
355
356# ----------------------------------------------------------------------
357# drawVectors - draw vectors from this particle
358#               to all particles it is linked to.
359# ----------------------------------------------------------------------
360itcl::body Rappture::VideoParticle::drawVectors {} {
361
362    if {[string compare "" $trajcallback] != 0} {
363        set _link [uplevel \#0 $trajcallback $this ${_nextnode}]
364    }
365}
366
367
368# ----------------------------------------------------------------------
369#   Coords ?<x0> <y0>? - update the coordinates of this object
370# ----------------------------------------------------------------------
371itcl::body Rappture::VideoParticle::Coords {args} {
372    if {[llength $args] == 0} {
373        return ${_coords}
374    } elseif {[llength $args] == 1} {
375        foreach {x0 y0} [lindex $args 0] break
376    } elseif {[llength $args] == 2} {
377        foreach {x0 y0} $args break
378    } else {
379        error "wrong # args: should be \"Coords ?<x0> <y0>?\""
380    }
381
382    if {([string is double $x0] != 1)} {
383        error "bad value: \"$x0\": x coordinate should be a double"
384    }
385    if {([string is double $y0] != 1)} {
386        error "bad value: \"$y0\": y coordinate should be a double"
387    }
388
389    set _coords [list $x0 $y0]
390    set coords [list [expr $x0-${_halo}] [expr $y0-${_halo}] \
391                     [expr $x0+${_halo}] [expr $y0+${_halo}]]
392
393    if {[llength [${_canvas} find withtag ${_name}-particle]] > 0} {
394        eval ${_canvas} coords ${_name}-particle $coords
395    }
396
397    _fixValue
398    return ${_coords}
399}
400
401# ----------------------------------------------------------------------
402#   Frame ?<frameNum>? - update the frame this object is in
403# ----------------------------------------------------------------------
404itcl::body Rappture::VideoParticle::Frame {args} {
405    if {[llength $args] == 1} {
406        set val [lindex $args 0]
407        if {([string is integer $val] != 1)} {
408            error "bad value: \"$val\": frame number should be an integer"
409        }
410
411        set _frame $val
412
413        if {"" != $itk_option(-onframe)} {
414            uplevel \#0 $itk_option(-onframe) ${_frame}
415        }
416
417        drawVectors
418        if {[string compare "" ${_prevnode}] != 0} {
419            ${_prevnode} drawVectors
420        }
421    } elseif {[llength $args] != 0} {
422        error "wrong # args: should be \"Frame ?<number>?\""
423    }
424    return ${_frame}
425}
426
427
428# ----------------------------------------------------------------------
429# next - get/set the next particle
430# ----------------------------------------------------------------------
431itcl::body Rappture::VideoParticle::next {args} {
432    if {[llength $args] == 1} {
433        # set the next node
434        set _nextnode [lindex $args 0]
435        # drawVectors
436    }
437    return ${_nextnode}
438}
439
440# ----------------------------------------------------------------------
441# prev - get/set the prev particle
442# ----------------------------------------------------------------------
443itcl::body Rappture::VideoParticle::prev {args} {
444    if {[llength $args] == 1} {
445        # set the prev node
446        set _prevnode [lindex $args 0]
447    }
448    return ${_prevnode}
449}
450
451# ----------------------------------------------------------------------
452# name - get the name of the particle
453# ----------------------------------------------------------------------
454itcl::body Rappture::VideoParticle::name {} {
455    return ${_name}
456}
457
458# ----------------------------------------------------------------------
459# USAGE: _fixValue
460# Invoked automatically whenever the -px2dist associated with this
461# widget is modified.  Copies the value to the current settings for
462# the widget.
463# ----------------------------------------------------------------------
464itcl::body Rappture::VideoParticle::_fixValue {args} {
465    if {"" == $itk_option(-px2dist)} {
466        return
467    }
468    upvar #0 $itk_option(-px2dist) var
469
470    drawVectors
471}
472
473# ----------------------------------------------------------------------
474# USAGE: _fixPx2Dist
475# Invoked whenever the length part of the trajectory for this object
476# is changed by the user via the popup menu.
477# ----------------------------------------------------------------------
478itcl::body Rappture::VideoParticle::_fixPx2Dist {px2dist} {
479    if {"" == $itk_option(-px2dist)} {
480        return
481    }
482    upvar #0 $itk_option(-px2dist) var
483    set var $px2dist
484}
485
486# ----------------------------------------------------------------------
487# _fixBindings - enable/disable bindings
488#   enable
489#   disable
490# ----------------------------------------------------------------------
491itcl::body Rappture::VideoParticle::_fixBindings {status} {
492    switch -- $status {
493        "enable" {
494            ${_canvas} bind ${_name} <ButtonPress-1>   [itcl::code $this Move press %x %y]
495            ${_canvas} bind ${_name} <B1-Motion>       [itcl::code $this Move motion %x %y]
496            ${_canvas} bind ${_name} <ButtonRelease-1> [itcl::code $this Move release %x %y]
497
498            ${_canvas} bind ${_name} <ButtonPress-3>   [itcl::code $this Menu activate %x %y]
499
500            ${_canvas} bind ${_name} <Enter>           [itcl::code $this Enter]
501            ${_canvas} bind ${_name} <Leave>           [itcl::code $this Leave]
502
503            ${_canvas} bind ${_name} <B1-Enter>        { }
504            ${_canvas} bind ${_name} <B1-Leave>        { }
505            # bind ${_canvas} <<Frame>>                  +[itcl::code $this CatchEvent Frame]
506            bindtags ${_canvas} [concat ${_name}-FrameEvent [bindtags ${_canvas}]]
507        }
508        "disable" {
509            ${_canvas} bind ${_name} <ButtonPress-1>   { }
510            ${_canvas} bind ${_name} <B1-Motion>       { }
511            ${_canvas} bind ${_name} <ButtonRelease-1> { }
512
513            ${_canvas} bind ${_name} <ButtonPress-3>   { }
514
515            ${_canvas} bind ${_name} <Enter>           { }
516            ${_canvas} bind ${_name} <Leave>           { }
517
518            ${_canvas} bind ${_name} <B1-Enter>        { }
519            ${_canvas} bind ${_name} <B1-Leave>        { }
520            set tagnum [lsearch [bindtags ${_canvas}] "${_name}-FrameEvent"]
521            if {$tagnum >= 0} {
522                bindtags ${_canvas} [lreplace [bindtags ${_canvas}] $tagnum $tagnum]
523            }
524        }
525        default {
526            error "bad option \"$status\": should be one of enable, disable."
527        }
528    }
529}
530
531
532# ----------------------------------------------------------------------
533# CONFIGURATION OPTION: -halo
534# ----------------------------------------------------------------------
535itcl::configbody Rappture::VideoParticle::halo {
536    if {[string is double $itk_option(-halo)] == 1} {
537        set _halo $itk_option(-halo)
538    } else {
539        error "bad value: \"$itk_option(-halo)\": halo should be a number"
540    }
541}
542
543# ----------------------------------------------------------------------
544# CONFIGURATION OPTION: -color
545# ----------------------------------------------------------------------
546itcl::configbody Rappture::VideoParticle::color {
547    if {[string compare "" $itk_option(-color)] != 0} {
548        # FIXME how to tell if the color is valid?
549        set _color $itk_option(-color)
550    } else {
551        error "bad value: \"$itk_option(-color)\": should be a valid color"
552    }
553}
554
555# ----------------------------------------------------------------------
556# CONFIGURE: -px2dist
557# ----------------------------------------------------------------------
558itcl::configbody Rappture::VideoParticle::px2dist {
559    if {"" != $_px2dist} {
560        upvar #0 $_px2dist var
561        trace remove variable var write [itcl::code $this _fixValue]
562    }
563
564    set _px2dist $itk_option(-px2dist)
565
566    if {"" != $_px2dist} {
567        upvar #0 $_px2dist var
568        trace add variable var write [itcl::code $this _fixValue]
569
570        # sync to the current value of this variable
571        if {[info exists var]} {
572            _fixValue
573        }
574    }
575}
576
577
578# ----------------------------------------------------------------------
579# CONFIGURE: -units
580# ----------------------------------------------------------------------
581itcl::configbody Rappture::VideoParticle::units {
582    set _units $itk_option(-units)
583    # _fixValue
584}
585
586
587# ----------------------------------------------------------------------
588# CONFIGURE: -bindings
589# ----------------------------------------------------------------------
590itcl::configbody Rappture::VideoParticle::bindings {
591    _fixBindings $itk_option(-bindings)
592}
593
594# ----------------------------------------------------------------------
595# CONFIGURE: -framerange
596# ----------------------------------------------------------------------
597itcl::configbody Rappture::VideoParticle::framerange {
598    if {"" == $itk_option(-framerange)} {
599        return
600    }
601    if {[llength $itk_option(-framerange)] != 2} {
602        error "bad value \"$itk_option(-framerange)\": should be 2 integers"
603    }
604    foreach {min max} $itk_option(-framerange) break
605    if {!([string is integer $min]) || !([string is integer $max])} {
606        error "bad value \"$itk_option(-framerange)\": should be 2 integers"
607    }
608    set controls [$itk_component(menu) component inner]
609    $controls.framenume configure -min $min -max $max
610}
611
612# ----------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.