1 | # ---------------------------------------------------------------------- |
---|
2 | # COMPONENT: video - viewing movies |
---|
3 | # |
---|
4 | # ====================================================================== |
---|
5 | # AUTHOR: Michael McLennan, Purdue University |
---|
6 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
7 | # |
---|
8 | # See the file "license.terms" for information on usage and redistribution of |
---|
9 | # this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
10 | # ====================================================================== |
---|
11 | |
---|
12 | package require Itk |
---|
13 | package require BLT |
---|
14 | package require Img |
---|
15 | package require Rappture |
---|
16 | package require RapptureGUI |
---|
17 | |
---|
18 | option add *Video.width -1 widgetDefault |
---|
19 | option add *Video.height -1 widgetDefault |
---|
20 | option add *Video.foreground black widgetDefault |
---|
21 | option add *Video.controlBackground gray widgetDefault |
---|
22 | option add *Video.font \ |
---|
23 | -*-helvetica-medium-r-normal-*-12-* widgetDefault |
---|
24 | |
---|
25 | itcl::class Rappture::VideoScreen { |
---|
26 | inherit itk::Widget |
---|
27 | |
---|
28 | itk_option define -width width Width -1 |
---|
29 | itk_option define -height height Height -1 |
---|
30 | itk_option define -fileopen fileopen Fileopen "" |
---|
31 | |
---|
32 | constructor { args } { |
---|
33 | # defined below |
---|
34 | } |
---|
35 | destructor { |
---|
36 | # defined below |
---|
37 | } |
---|
38 | |
---|
39 | public method load {type data} |
---|
40 | public method loadcb {args} |
---|
41 | public method video {args} |
---|
42 | public method query {type} |
---|
43 | |
---|
44 | protected method Play {} |
---|
45 | protected method Seek {n} |
---|
46 | protected method fixSize {} |
---|
47 | protected method Upload {args} |
---|
48 | protected method eventually {args} |
---|
49 | |
---|
50 | private method togglePtrCtrl {pbvar} |
---|
51 | private method whatPtrCtrl {} |
---|
52 | private method togglePtrBind {pbvar} |
---|
53 | |
---|
54 | # drawing tools |
---|
55 | private method Rubberband {status win x y} |
---|
56 | private method updateMeasurements {} |
---|
57 | private method Measure {status win x y} |
---|
58 | private method Particle {status win x y} |
---|
59 | private method Trajectory {args} |
---|
60 | private method calculateTrajectory {args} |
---|
61 | private method writeText {x y text color tags width} |
---|
62 | private method clearDrawings {} |
---|
63 | |
---|
64 | # video dial tools |
---|
65 | private method toggleloop {} |
---|
66 | |
---|
67 | private common _settings |
---|
68 | private common _pendings |
---|
69 | private common _pbvars |
---|
70 | private common _counters |
---|
71 | |
---|
72 | private variable _width -1 ;# width of the movie |
---|
73 | private variable _height -1 ;# height of the movie |
---|
74 | private variable _movie "" ;# movie we grab images from |
---|
75 | private variable _lastFrame 0 ;# last frame in the movie |
---|
76 | private variable _imh "" ;# current image being displayed |
---|
77 | private variable _id "" ;# id of the next play command from after |
---|
78 | private variable _framerate 30 ;# video frame rate |
---|
79 | private variable _mspf 7 ;# milliseconds per frame wait time |
---|
80 | private variable _ofrd 19 ;# observed frame retrieval delay of |
---|
81 | ;# underlying c lib in milliseconds |
---|
82 | private variable _delay 0 ;# milliseconds between play calls |
---|
83 | private variable _nextframe 0 ;# |
---|
84 | |
---|
85 | private variable _px2dist 0 ;# conversion for pixels to user specified distance |
---|
86 | private variable _particles "" ;# list of particles |
---|
87 | private variable _measurements "" ;# list of all measurement lines |
---|
88 | private variable _obj "" ;# temp var holding the last created object |
---|
89 | } |
---|
90 | |
---|
91 | |
---|
92 | itk::usual VideoScreen { |
---|
93 | keep -background -foreground -cursor -font |
---|
94 | keep -plotbackground -plotforeground |
---|
95 | } |
---|
96 | |
---|
97 | # ---------------------------------------------------------------------- |
---|
98 | # CONSTRUCTOR |
---|
99 | # ---------------------------------------------------------------------- |
---|
100 | itcl::body Rappture::VideoScreen::constructor {args} { |
---|
101 | |
---|
102 | array set _settings [subst { |
---|
103 | framenum 0 |
---|
104 | loop 0 |
---|
105 | play 0 |
---|
106 | speed 1 |
---|
107 | }] |
---|
108 | |
---|
109 | array set _pendings { |
---|
110 | seek 0 |
---|
111 | play 0 |
---|
112 | } |
---|
113 | |
---|
114 | array set _counters { |
---|
115 | particle 0 |
---|
116 | measure 0 |
---|
117 | } |
---|
118 | |
---|
119 | # Create flow controls... |
---|
120 | |
---|
121 | itk_component add main { |
---|
122 | canvas $itk_interior.main |
---|
123 | } { |
---|
124 | usual |
---|
125 | rename -background -controlbackground controlBackground Background |
---|
126 | } |
---|
127 | bind $itk_component(main) <Configure> [itcl::code $this fixSize] |
---|
128 | |
---|
129 | # setup the image display |
---|
130 | # hold the video frames in an image on the canvas |
---|
131 | set _imh [image create photo] |
---|
132 | |
---|
133 | $itk_component(main) create image 0 0 \ |
---|
134 | -anchor center \ |
---|
135 | -image ${_imh} \ |
---|
136 | -tags videoframe |
---|
137 | |
---|
138 | # setup movie controls |
---|
139 | itk_component add moviecontrols { |
---|
140 | frame $itk_interior.moviecontrols |
---|
141 | } { |
---|
142 | usual |
---|
143 | rename -background -controlbackground controlBackground Background |
---|
144 | } |
---|
145 | |
---|
146 | # setup frame number frame |
---|
147 | itk_component add frnumfr { |
---|
148 | frame $itk_component(moviecontrols).frnumfr |
---|
149 | } { |
---|
150 | usual |
---|
151 | rename -background -controlbackground controlBackground Background |
---|
152 | } |
---|
153 | |
---|
154 | set imagesDir [file join $RapptureGUI::library scripts images] |
---|
155 | |
---|
156 | # ==== fileopen ==== |
---|
157 | itk_component add fileopen { |
---|
158 | button $itk_component(moviecontrols).fileopen \ |
---|
159 | -borderwidth 1 -padx 1 -pady 1 \ |
---|
160 | -image [Rappture::icon upload] \ |
---|
161 | -command [itcl::code $this loadcb] |
---|
162 | } { |
---|
163 | usual |
---|
164 | } |
---|
165 | Rappture::Tooltip::for $itk_component(fileopen) \ |
---|
166 | "Open file" |
---|
167 | |
---|
168 | # ==== measuring tool ==== |
---|
169 | set measImg [image create photo -file [file join $imagesDir "line_darrow_green.png"]] |
---|
170 | itk_component add measure { |
---|
171 | Rappture::PushButton $itk_component(moviecontrols).measurepb \ |
---|
172 | -onimage $measImg \ |
---|
173 | -offimage $measImg \ |
---|
174 | -disabledimage $measImg \ |
---|
175 | -command [itcl::code $this togglePtrCtrl "measure"] \ |
---|
176 | -variable [itcl::scope _pbvars(measure)] |
---|
177 | } { |
---|
178 | usual |
---|
179 | } |
---|
180 | $itk_component(measure) disable |
---|
181 | Rappture::Tooltip::for $itk_component(measure) \ |
---|
182 | "Measure the distance of a structure" |
---|
183 | |
---|
184 | # ==== particle mark tool ==== |
---|
185 | set particleImg [image create photo -file [file join $imagesDir "volume-on.gif"]] |
---|
186 | itk_component add particle { |
---|
187 | Rappture::PushButton $itk_component(moviecontrols).particlepb \ |
---|
188 | -onimage $particleImg \ |
---|
189 | -offimage $particleImg \ |
---|
190 | -disabledimage $particleImg \ |
---|
191 | -command [itcl::code $this togglePtrCtrl "particle"] \ |
---|
192 | -variable [itcl::scope _pbvars(particle)] |
---|
193 | } { |
---|
194 | usual |
---|
195 | } |
---|
196 | $itk_component(particle) disable |
---|
197 | Rappture::Tooltip::for $itk_component(particle) \ |
---|
198 | "Mark the location of a particle to follow" |
---|
199 | |
---|
200 | |
---|
201 | # Rewind |
---|
202 | itk_component add rewind { |
---|
203 | button $itk_component(moviecontrols).rewind \ |
---|
204 | -borderwidth 1 -padx 1 -pady 1 \ |
---|
205 | -image [Rappture::icon video-rewind] \ |
---|
206 | -command [itcl::code $this video seek 0] |
---|
207 | } { |
---|
208 | usual |
---|
209 | ignore -borderwidth |
---|
210 | rename -highlightbackground -controlbackground controlBackground \ |
---|
211 | Background |
---|
212 | } |
---|
213 | $itk_component(rewind) configure -state disabled |
---|
214 | Rappture::Tooltip::for $itk_component(rewind) \ |
---|
215 | "Rewind movie" |
---|
216 | |
---|
217 | # Seek back |
---|
218 | itk_component add seekback { |
---|
219 | button $itk_component(moviecontrols).seekback \ |
---|
220 | -borderwidth 1 -padx 1 -pady 1 \ |
---|
221 | -image [Rappture::icon flow-rewind] \ |
---|
222 | -command [itcl::code $this video seek -1] |
---|
223 | } { |
---|
224 | usual |
---|
225 | ignore -borderwidth |
---|
226 | rename -highlightbackground -controlbackground controlBackground \ |
---|
227 | Background |
---|
228 | } |
---|
229 | $itk_component(seekback) configure -state disabled |
---|
230 | Rappture::Tooltip::for $itk_component(rewind) \ |
---|
231 | "Seek backwards 1 frame" |
---|
232 | |
---|
233 | # Play |
---|
234 | itk_component add play { |
---|
235 | Rappture::PushButton $itk_component(moviecontrols).play \ |
---|
236 | -onimage [Rappture::icon flow-pause] \ |
---|
237 | -offimage [Rappture::icon flow-play] \ |
---|
238 | -disabledimage [Rappture::icon flow-play] \ |
---|
239 | -variable [itcl::scope _settings(play)] \ |
---|
240 | -command [itcl::code $this video play] |
---|
241 | } |
---|
242 | $itk_component(play) disable |
---|
243 | Rappture::Tooltip::for $itk_component(play) \ |
---|
244 | "Play/Pause movie" |
---|
245 | |
---|
246 | # Seek forward |
---|
247 | itk_component add seekforward { |
---|
248 | button $itk_component(moviecontrols).seekforward \ |
---|
249 | -borderwidth 1 -padx 1 -pady 1 \ |
---|
250 | -image [Rappture::icon flow-forward] \ |
---|
251 | -command [itcl::code $this video seek +1] |
---|
252 | } { |
---|
253 | usual |
---|
254 | ignore -borderwidth |
---|
255 | rename -highlightbackground -controlbackground controlBackground \ |
---|
256 | Background |
---|
257 | } |
---|
258 | $itk_component(seekforward) configure -state disabled |
---|
259 | Rappture::Tooltip::for $itk_component(seekforward) \ |
---|
260 | "Seek forward 1 frame" |
---|
261 | |
---|
262 | # Loop |
---|
263 | itk_component add loop { |
---|
264 | Rappture::PushButton $itk_component(moviecontrols).loop \ |
---|
265 | -onimage [Rappture::icon flow-loop] \ |
---|
266 | -offimage [Rappture::icon flow-loop] \ |
---|
267 | -disabledimage [Rappture::icon flow-loop] \ |
---|
268 | -variable [itcl::scope _settings(loop)] \ |
---|
269 | -command [itcl::code $this toggleloop] |
---|
270 | } |
---|
271 | $itk_component(loop) disable |
---|
272 | Rappture::Tooltip::for $itk_component(loop) \ |
---|
273 | "Play continuously between marked sections" |
---|
274 | |
---|
275 | itk_component add dial { |
---|
276 | frame $itk_interior.dial |
---|
277 | } { |
---|
278 | usual |
---|
279 | rename -background -controlbackground controlBackground Background |
---|
280 | } |
---|
281 | |
---|
282 | # Video Dial Major |
---|
283 | itk_component add dialmajor { |
---|
284 | Rappture::Videodial1 $itk_component(dial).dialmajor \ |
---|
285 | -length 10 -valuewidth 0 -valuepadding 0 -padding 6 \ |
---|
286 | -linecolor "" -activelinecolor "" \ |
---|
287 | -min 0 -max 1 \ |
---|
288 | -variable [itcl::scope _settings(framenum)] \ |
---|
289 | -dialoutlinecolor black \ |
---|
290 | -knobimage [Rappture::icon knob2] -knobposition center@middle |
---|
291 | } { |
---|
292 | usual |
---|
293 | ignore -dialprogresscolor |
---|
294 | rename -background -controlbackground controlBackground Background |
---|
295 | } |
---|
296 | $itk_component(dialmajor) current 0 |
---|
297 | bind $itk_component(dialmajor) <<Value>> [itcl::code $this video update] |
---|
298 | |
---|
299 | # Video Dial Minor |
---|
300 | itk_component add dialminor { |
---|
301 | Rappture::Videodial2 $itk_component(dial).dialminor \ |
---|
302 | -padding 0 \ |
---|
303 | -min 0 -max 1 \ |
---|
304 | -minortick 1 -majortick 5 \ |
---|
305 | -variable [itcl::scope _settings(framenum)] \ |
---|
306 | -dialoutlinecolor black |
---|
307 | } { |
---|
308 | usual |
---|
309 | rename -background -controlbackground controlBackground Background |
---|
310 | } |
---|
311 | $itk_component(dialminor) current 0 |
---|
312 | bind $itk_component(dialminor) <<Value>> [itcl::code $this video update] |
---|
313 | |
---|
314 | set fg [option get $itk_component(hull) font Font] |
---|
315 | |
---|
316 | itk_component add framenumlabel { |
---|
317 | label $itk_component(frnumfr).framenuml -text "Frame:" -font "arial 9" \ |
---|
318 | -highlightthickness 0 |
---|
319 | } { |
---|
320 | usual |
---|
321 | ignore -highlightthickness |
---|
322 | rename -background -controlbackground controlBackground Background |
---|
323 | } |
---|
324 | |
---|
325 | # Current Frame Number |
---|
326 | itk_component add framenum { |
---|
327 | label $itk_component(frnumfr).framenum \ |
---|
328 | -background white -font "arial 9" \ |
---|
329 | -textvariable [itcl::scope _settings(framenum)] |
---|
330 | } { |
---|
331 | usual |
---|
332 | ignore -highlightthickness |
---|
333 | rename -background -controlbackground controlBackground Background |
---|
334 | } |
---|
335 | Rappture::Tooltip::for $itk_component(framenum) \ |
---|
336 | "Current frame number" |
---|
337 | |
---|
338 | |
---|
339 | pack $itk_component(framenumlabel) -side left |
---|
340 | pack $itk_component(framenum) -side right |
---|
341 | |
---|
342 | |
---|
343 | itk_component add speedlabel { |
---|
344 | label $itk_component(moviecontrols).speedl -text "Speed:" -font $fg \ |
---|
345 | -highlightthickness 0 |
---|
346 | } { |
---|
347 | usual |
---|
348 | ignore -highlightthickness |
---|
349 | rename -background -controlbackground controlBackground Background |
---|
350 | } |
---|
351 | |
---|
352 | # Speed |
---|
353 | itk_component add speed { |
---|
354 | Rappture::Videospeed $itk_component(moviecontrols).speed \ |
---|
355 | -min 0 -max 1 -width 4 -font "arial 9" -factor 2 |
---|
356 | } { |
---|
357 | usual |
---|
358 | ignore -highlightthickness |
---|
359 | rename -background -controlbackground controlBackground Background |
---|
360 | } |
---|
361 | Rappture::Tooltip::for $itk_component(speed) \ |
---|
362 | "Change speed of movie" |
---|
363 | |
---|
364 | $itk_component(speed) value 0.25 |
---|
365 | bind $itk_component(speed) <<Value>> [itcl::code $this video speed] |
---|
366 | |
---|
367 | |
---|
368 | blt::table $itk_component(dial) \ |
---|
369 | 0,0 $itk_component(dialmajor) -fill x \ |
---|
370 | 1,0 $itk_component(dialminor) -fill x |
---|
371 | |
---|
372 | blt::table $itk_component(moviecontrols) \ |
---|
373 | 0,0 $itk_component(fileopen) -padx {2 0} \ |
---|
374 | 0,1 $itk_component(measure) -padx {4 0} \ |
---|
375 | 0,2 $itk_component(particle) -padx {4 0} \ |
---|
376 | 0,5 $itk_component(dial) -fill x -padx {2 4} -rowspan 3 \ |
---|
377 | 1,0 $itk_component(rewind) -padx {2 0} \ |
---|
378 | 1,1 $itk_component(seekback) -padx {4 0} \ |
---|
379 | 1,2 $itk_component(play) -padx {4 0} \ |
---|
380 | 1,3 $itk_component(seekforward) -padx {4 0} \ |
---|
381 | 1,4 $itk_component(loop) -padx {4 0} \ |
---|
382 | 2,0 $itk_component(frnumfr) -padx {0 0} -columnspan 3 \ |
---|
383 | 2,3 $itk_component(speed) -padx {2 0} -columnspan 2 |
---|
384 | |
---|
385 | blt::table configure $itk_component(moviecontrols) c* -resize none |
---|
386 | blt::table configure $itk_component(moviecontrols) c5 -resize both |
---|
387 | blt::table configure $itk_component(moviecontrols) r0 -pady 1 |
---|
388 | |
---|
389 | |
---|
390 | blt::table $itk_interior \ |
---|
391 | 0,0 $itk_component(main) -fill both \ |
---|
392 | 1,0 $itk_component(moviecontrols) -fill x |
---|
393 | blt::table configure $itk_interior c* -resize both |
---|
394 | blt::table configure $itk_interior r0 -resize both |
---|
395 | blt::table configure $itk_interior r1 -resize none |
---|
396 | |
---|
397 | eval itk_initialize $args |
---|
398 | |
---|
399 | $itk_component(main) configure -background black |
---|
400 | } |
---|
401 | |
---|
402 | # ---------------------------------------------------------------------- |
---|
403 | # DESTRUCTOR |
---|
404 | # ---------------------------------------------------------------------- |
---|
405 | itcl::body Rappture::VideoScreen::destructor {} { |
---|
406 | array unset _settings * |
---|
407 | array unset _pendings * |
---|
408 | array unset _pbvars * |
---|
409 | array unset _counters * |
---|
410 | |
---|
411 | |
---|
412 | if {[info exists _imh] && ("" != ${_imh})} { |
---|
413 | image delete ${_imh} |
---|
414 | set _imh "" |
---|
415 | } |
---|
416 | |
---|
417 | if {[info exists measImg]} { |
---|
418 | image delete $measImg |
---|
419 | set measImg "" |
---|
420 | } |
---|
421 | |
---|
422 | if {[info exists particleImg]} { |
---|
423 | image delete $particleImg |
---|
424 | set particleImg "" |
---|
425 | } |
---|
426 | |
---|
427 | if {("" != [info commands ${_movie}])} { |
---|
428 | # clear the movie if it is still open |
---|
429 | ${_movie} release |
---|
430 | set _movie "" |
---|
431 | } |
---|
432 | |
---|
433 | clearDrawings |
---|
434 | } |
---|
435 | |
---|
436 | # ---------------------------------------------------------------------- |
---|
437 | # clearDrawings - delete all particle and measurement objects |
---|
438 | # ---------------------------------------------------------------------- |
---|
439 | itcl::body Rappture::VideoScreen::clearDrawings {} { |
---|
440 | |
---|
441 | # delete all previously placed particles |
---|
442 | set obj [lindex ${_particles} end] |
---|
443 | while {"" != [info commands $obj]} { |
---|
444 | itcl::delete object $obj |
---|
445 | set _particles [lreplace ${_particles} end end] |
---|
446 | if {[llength ${_particles}] == 0} { |
---|
447 | break |
---|
448 | } |
---|
449 | set obj [lindex ${_particles} end] |
---|
450 | } |
---|
451 | |
---|
452 | # delete all previously placed measurements |
---|
453 | set obj [lindex ${_measurements} end] |
---|
454 | while {"" != [info commands $obj]} { |
---|
455 | itcl::delete object $obj |
---|
456 | set _measurements [lreplace ${_measurements} end end] |
---|
457 | if {[llength ${_measurements}] == 0} { |
---|
458 | break |
---|
459 | } |
---|
460 | set obj [lindex ${_measurements} end] |
---|
461 | } |
---|
462 | } |
---|
463 | |
---|
464 | # ---------------------------------------------------------------------- |
---|
465 | # load - load a video file |
---|
466 | # type - type of data, "data" or "file" |
---|
467 | # data - what to load. |
---|
468 | # if type == "data", data is treated like binary data |
---|
469 | # if type == "file", data is treated like the name of a file |
---|
470 | # and is opened and then loaded. |
---|
471 | # ---------------------------------------------------------------------- |
---|
472 | itcl::body Rappture::VideoScreen::load {type data} { |
---|
473 | |
---|
474 | video stop |
---|
475 | |
---|
476 | # open the file |
---|
477 | set fname "" |
---|
478 | switch $type { |
---|
479 | "data" { |
---|
480 | if {"" == $data} { |
---|
481 | error "bad value \"$data\": data should be a movie" |
---|
482 | } |
---|
483 | |
---|
484 | set fname "/tmp/tmpVV[pid].video" |
---|
485 | set fid [open $fname "w"] |
---|
486 | fconfigure $fid -translation binary -encoding binary |
---|
487 | puts $fid $data |
---|
488 | close $fid |
---|
489 | set type "file" |
---|
490 | set data $fname |
---|
491 | } |
---|
492 | "file" { |
---|
493 | if {"" == $data} { |
---|
494 | error "bad value \"$data\": data should be a movie file path" |
---|
495 | } |
---|
496 | # do nothing |
---|
497 | } |
---|
498 | default { |
---|
499 | error "bad value: \"$type\": should be \"load \[data|file\] <data>\"" |
---|
500 | } |
---|
501 | } |
---|
502 | |
---|
503 | if {"file" == $type} { |
---|
504 | if {("" != [info commands ${_movie}])} { |
---|
505 | # compare the new file name to the name of the file |
---|
506 | # we already have open in our _movie object. |
---|
507 | # if they are the same, do not reopen the video. |
---|
508 | # if they are different, close the old movie |
---|
509 | # and clear out all old drawings from the canvas. |
---|
510 | set err [catch {${_movie} filename} filename] |
---|
511 | if {($err == 0)&& ($data == $filename)} { |
---|
512 | # video file already open, don't reopen it. |
---|
513 | return |
---|
514 | } else { |
---|
515 | # clear the old movie |
---|
516 | ${_movie} release |
---|
517 | set _width -1 |
---|
518 | set _height -1 |
---|
519 | |
---|
520 | # delete drawings objects from canvas |
---|
521 | clearDrawings |
---|
522 | } |
---|
523 | } |
---|
524 | } |
---|
525 | |
---|
526 | set _movie [Rappture::Video $type $data] |
---|
527 | if {"" != $fname} { |
---|
528 | file delete $fname |
---|
529 | } |
---|
530 | set _framerate [${_movie} framerate] |
---|
531 | video speed |
---|
532 | puts stderr "framerate: ${_framerate}" |
---|
533 | |
---|
534 | set _lastFrame [${_movie} get position end] |
---|
535 | |
---|
536 | # update the dial with video information |
---|
537 | $itk_component(dialmajor) configure -min 0 -max ${_lastFrame} |
---|
538 | $itk_component(dialminor) configure -min 0 -max ${_lastFrame} |
---|
539 | |
---|
540 | # turn on the buttons and dials |
---|
541 | $itk_component(measure) enable |
---|
542 | $itk_component(particle) enable |
---|
543 | $itk_component(rewind) configure -state normal |
---|
544 | $itk_component(seekback) configure -state normal |
---|
545 | $itk_component(play) enable |
---|
546 | $itk_component(seekforward) configure -state normal |
---|
547 | $itk_component(loop) enable |
---|
548 | |
---|
549 | # make sure looping is off |
---|
550 | set _settings(loop) 0 |
---|
551 | $itk_component(dialminor) loop disable |
---|
552 | |
---|
553 | fixSize |
---|
554 | |
---|
555 | # goto the first frame |
---|
556 | # update the dial and framenum widgets |
---|
557 | video seek 0 |
---|
558 | set _settings(framenum) 0 |
---|
559 | } |
---|
560 | |
---|
561 | # ---------------------------------------------------------------------- |
---|
562 | # loadcb - load callback |
---|
563 | # ---------------------------------------------------------------------- |
---|
564 | itcl::body Rappture::VideoScreen::loadcb {args} { |
---|
565 | video stop |
---|
566 | Rappture::filexfer::upload {piv tool} {id label desc} [itcl::code $this Upload] |
---|
567 | } |
---|
568 | |
---|
569 | # ---------------------------------------------------------------------- |
---|
570 | # Upload - |
---|
571 | # ---------------------------------------------------------------------- |
---|
572 | itcl::body Rappture::VideoScreen::Upload {args} { |
---|
573 | array set data $args |
---|
574 | video stop |
---|
575 | |
---|
576 | if {[info exists data(error)]} { |
---|
577 | Rappture::Tooltip::cue $itk::component(main) $data(error) |
---|
578 | puts stderr $data(error) |
---|
579 | } |
---|
580 | |
---|
581 | if {[info exists data(path)] && [info exists data(data)]} { |
---|
582 | Rappture::Tooltip::cue hide ;# take down note about the popup window |
---|
583 | |
---|
584 | # load data |
---|
585 | load "data" $data(data) |
---|
586 | } |
---|
587 | |
---|
588 | } |
---|
589 | |
---|
590 | |
---|
591 | # ---------------------------------------------------------------------- |
---|
592 | # fixSize |
---|
593 | # ---------------------------------------------------------------------- |
---|
594 | itcl::body Rappture::VideoScreen::fixSize {} { |
---|
595 | |
---|
596 | if {[string compare "" ${_movie}] == 0} { |
---|
597 | return |
---|
598 | } |
---|
599 | |
---|
600 | if {![winfo ismapped $itk_component(hull)]} { |
---|
601 | return |
---|
602 | } |
---|
603 | |
---|
604 | # get dimensions for the new image |
---|
605 | # adjust the aspect ratio, if necessary |
---|
606 | |
---|
607 | puts stderr "aspect ratio: [query aspectratio]" |
---|
608 | |
---|
609 | foreach {w h} [query dimensions] break |
---|
610 | foreach {num den} [query aspectratio] break |
---|
611 | |
---|
612 | if {[expr 1.0*$w/$h] != [expr 1.0*$num/$den]} { |
---|
613 | # we need to adjust the frame height and width |
---|
614 | # to keep the correct aspect ratio |
---|
615 | # hold the height constant, |
---|
616 | # adjust the width as close as we can |
---|
617 | # to the correct aspect ratio |
---|
618 | set w [expr int(1.0*$num/$den*$h)] |
---|
619 | } |
---|
620 | |
---|
621 | if {-1 == ${_width}} { |
---|
622 | set _width $w |
---|
623 | } |
---|
624 | if {-1 == ${_height}} { |
---|
625 | set _height $h |
---|
626 | } |
---|
627 | |
---|
628 | # get an image with the new size |
---|
629 | ${_imh} blank |
---|
630 | ${_imh} configure -width 1 -height 1 |
---|
631 | ${_imh} configure -width 0 -height 0 |
---|
632 | ${_imh} put [${_movie} get image ${_width} ${_height}] |
---|
633 | |
---|
634 | # place the image in the center of the canvas |
---|
635 | set ccw [winfo width $itk_component(main)] |
---|
636 | set cch [winfo height $itk_component(main)] |
---|
637 | $itk_component(main) coords videoframe [expr $ccw/2.0] [expr $cch/2.0] |
---|
638 | |
---|
639 | puts stderr "----------------------------" |
---|
640 | puts stderr "adjusted = $w $h" |
---|
641 | puts stderr "data = ${_width} ${_height}" |
---|
642 | puts stderr "image = [image width ${_imh}] [image height ${_imh}]" |
---|
643 | foreach {x0 y0 x1 y1} [$itk_component(main) bbox videoframe] break |
---|
644 | puts stderr "bbox = $x0 $y0 $x1 $y1" |
---|
645 | puts stderr "ccw cch = [expr $ccw/2.0] [expr $cch/2.0]" |
---|
646 | puts stderr "main = [winfo width $itk_component(main)] [winfo height $itk_component(main)]" |
---|
647 | puts stderr "hull = [winfo width $itk_component(hull)] [winfo height $itk_component(hull)]" |
---|
648 | } |
---|
649 | |
---|
650 | # ---------------------------------------------------------------------- |
---|
651 | # video - play, stop, rewind, fastforward the video |
---|
652 | # ---------------------------------------------------------------------- |
---|
653 | itcl::body Rappture::VideoScreen::video { args } { |
---|
654 | set option [lindex $args 0] |
---|
655 | switch -- $option { |
---|
656 | "play" { |
---|
657 | if {$_settings(play) == 1} { |
---|
658 | eventually play |
---|
659 | } else { |
---|
660 | # pause/stop |
---|
661 | after cancel $_id |
---|
662 | set _pendings(play) 0 |
---|
663 | set _settings(play) 0 |
---|
664 | } |
---|
665 | } |
---|
666 | "seek" { |
---|
667 | Seek [lreplace $args 0 0] |
---|
668 | } |
---|
669 | "stop" { |
---|
670 | after cancel $_id |
---|
671 | set _settings(play) 0 |
---|
672 | } |
---|
673 | "speed" { |
---|
674 | set speed [$itk_component(speed) value] |
---|
675 | set _mspf [expr round(((1.0/${_framerate})*1000)/$speed)] |
---|
676 | set _delay [expr {${_mspf} - ${_ofrd}}] |
---|
677 | puts stderr "_mspf = ${_mspf} | $speed | ${_ofrd} | ${_delay}" |
---|
678 | } |
---|
679 | "update" { |
---|
680 | eventually seek [expr round($_settings(framenum))] |
---|
681 | # Seek [expr round($_settings(framenum))] |
---|
682 | } |
---|
683 | default { |
---|
684 | error "bad option \"$option\": should be play, stop, toggle, position, or reset." |
---|
685 | } |
---|
686 | } |
---|
687 | } |
---|
688 | |
---|
689 | # ---------------------------------------------------------------------- |
---|
690 | # query - query things about the video |
---|
691 | # |
---|
692 | # dimensions - returns width and height as a list |
---|
693 | # frames - number of frames in video (last frame + 1) |
---|
694 | # framenum - current position |
---|
695 | # ---------------------------------------------------------------------- |
---|
696 | itcl::body Rappture::VideoScreen::query { type } { |
---|
697 | set ret "" |
---|
698 | switch -- $type { |
---|
699 | "aspectratio" { |
---|
700 | set ret [${_movie} aspect display] |
---|
701 | } |
---|
702 | "dimensions" { |
---|
703 | set ret [${_movie} size] |
---|
704 | } |
---|
705 | "frames" { |
---|
706 | set ret [expr [${_movie} get position end] + 1] |
---|
707 | } |
---|
708 | "framenum" { |
---|
709 | set ret [${_movie} get position cur] |
---|
710 | } |
---|
711 | default { |
---|
712 | error "bad type \"$type\": should be dimensions, frames, framenum." |
---|
713 | } |
---|
714 | } |
---|
715 | return $ret |
---|
716 | } |
---|
717 | |
---|
718 | # ---------------------------------------------------------------------- |
---|
719 | # Play - get the next video frame |
---|
720 | # ---------------------------------------------------------------------- |
---|
721 | itcl::body Rappture::VideoScreen::Play {} { |
---|
722 | |
---|
723 | set cur ${_nextframe} |
---|
724 | |
---|
725 | # time how long it takes to retrieve the next frame |
---|
726 | set _ofrd [time { |
---|
727 | # use seek instead of next fxn incase the ${_nextframe} is |
---|
728 | # not the current frame+1. this happens when we skip frames |
---|
729 | # because the underlying c lib is too slow at reading. |
---|
730 | ${_movie} seek $cur |
---|
731 | ${_imh} put [${_movie} get image ${_width} ${_height}] |
---|
732 | } 1] |
---|
733 | regexp {(\d+\.?\d*) microseconds per iteration} ${_ofrd} match _ofrd |
---|
734 | set _ofrd [expr {round(${_ofrd}/1000)}] |
---|
735 | |
---|
736 | # calculate the delay we shoud see |
---|
737 | # between frames being placed on screen |
---|
738 | # taking into account the cost of retrieving the frame |
---|
739 | set _delay [expr {${_mspf}-${_ofrd}}] |
---|
740 | if {0 > ${_delay}} { |
---|
741 | set _delay 0 |
---|
742 | } |
---|
743 | |
---|
744 | set cur [${_movie} get position cur] |
---|
745 | |
---|
746 | # update the dial and framenum widgets |
---|
747 | set _settings(framenum) $cur |
---|
748 | |
---|
749 | |
---|
750 | # no play cmds pending |
---|
751 | set _pendings(play) 0 |
---|
752 | |
---|
753 | # if looping is turned on and markers setup, |
---|
754 | # then loop back to loopstart when cur hits loopend |
---|
755 | if {$_settings(loop)} { |
---|
756 | if {$cur == [$itk_component(dialminor) mark position loopend]} { |
---|
757 | Seek [$itk_component(dialminor) mark position loopstart] |
---|
758 | } |
---|
759 | } |
---|
760 | |
---|
761 | # schedule the next frame to be displayed |
---|
762 | if {$cur < ${_lastFrame}} { |
---|
763 | set _id [after ${_delay} [itcl::code $this eventually play]] |
---|
764 | } else { |
---|
765 | video stop |
---|
766 | } |
---|
767 | |
---|
768 | event generate $itk_component(hull) <<Frame>> |
---|
769 | } |
---|
770 | |
---|
771 | |
---|
772 | # ---------------------------------------------------------------------- |
---|
773 | # Seek - go to a frame in the video |
---|
774 | # Seek +5 |
---|
775 | # Seek -5 |
---|
776 | # Seek 35 |
---|
777 | # ---------------------------------------------------------------------- |
---|
778 | itcl::body Rappture::VideoScreen::Seek {args} { |
---|
779 | set val [lindex $args 0] |
---|
780 | if {"" == $val} { |
---|
781 | error "bad value: \"$val\": should be \"seek value\"" |
---|
782 | } |
---|
783 | set cur [${_movie} get position cur] |
---|
784 | if {[string compare $cur $val] == 0} { |
---|
785 | # already at the frame to seek to |
---|
786 | set _pendings(seek) 0 |
---|
787 | return |
---|
788 | } |
---|
789 | ${_movie} seek $val |
---|
790 | ${_imh} put [${_movie} get image ${_width} ${_height}] |
---|
791 | |
---|
792 | # update the dial and framenum widgets |
---|
793 | set _settings(framenum) [${_movie} get position cur] |
---|
794 | event generate $itk_component(main) <<Frame>> |
---|
795 | |
---|
796 | # removing pending |
---|
797 | set _pendings(seek) 0 |
---|
798 | } |
---|
799 | |
---|
800 | |
---|
801 | # ---------------------------------------------------------------------- |
---|
802 | # eventually - |
---|
803 | # seek |
---|
804 | # play |
---|
805 | # ---------------------------------------------------------------------- |
---|
806 | itcl::body Rappture::VideoScreen::eventually {args} { |
---|
807 | set option [lindex $args 0] |
---|
808 | switch -- $option { |
---|
809 | "seek" { |
---|
810 | if {0 == $_pendings(seek)} { |
---|
811 | # no seek pending, schedule one |
---|
812 | set _pendings(seek) 1 |
---|
813 | after idle [itcl::code $this Seek [lindex $args 1]] |
---|
814 | } else { |
---|
815 | # there is a seek pending, update its seek value |
---|
816 | } |
---|
817 | } |
---|
818 | "play" { |
---|
819 | if {0 == $_pendings(play)} { |
---|
820 | # no play pending schedule one |
---|
821 | set _pendings(play) 1 |
---|
822 | set _nextframe [expr {[${_movie} get position cur] + 1}] |
---|
823 | after idle [itcl::code $this Play] |
---|
824 | } else { |
---|
825 | # there is a play pending, update its frame value |
---|
826 | incr _nextframe |
---|
827 | } |
---|
828 | } |
---|
829 | default { |
---|
830 | } |
---|
831 | } |
---|
832 | } |
---|
833 | |
---|
834 | |
---|
835 | # ---------------------------------------------------------------------- |
---|
836 | # togglePtrCtrl - choose pointer mode: |
---|
837 | # rectangle, measure, particlemark |
---|
838 | # ---------------------------------------------------------------------- |
---|
839 | itcl::body Rappture::VideoScreen::togglePtrCtrl {tool} { |
---|
840 | |
---|
841 | if {[info exists _pbvars($tool)] == 0} { |
---|
842 | return |
---|
843 | } |
---|
844 | |
---|
845 | if {$_pbvars($tool) == 1} { |
---|
846 | # unpush previously pushed buttons |
---|
847 | foreach pbv [array names _pbvars] { |
---|
848 | if {[string compare $tool $pbv] != 0} { |
---|
849 | set _pbvars($pbv) 0 |
---|
850 | } |
---|
851 | } |
---|
852 | } |
---|
853 | togglePtrBind $tool |
---|
854 | } |
---|
855 | |
---|
856 | |
---|
857 | # ---------------------------------------------------------------------- |
---|
858 | # whatPtrCtrl - figure out the current pointer mode: |
---|
859 | # rectangle, measure, particlemark |
---|
860 | # ---------------------------------------------------------------------- |
---|
861 | itcl::body Rappture::VideoScreen::whatPtrCtrl {} { |
---|
862 | foreach pbv [array names _pbvars] { |
---|
863 | if {$_pbvars($pbv) != 0} { |
---|
864 | return $pbv |
---|
865 | } |
---|
866 | } |
---|
867 | } |
---|
868 | |
---|
869 | |
---|
870 | # ---------------------------------------------------------------------- |
---|
871 | # togglePtrBind - update the bindings based on pointer controls |
---|
872 | # ---------------------------------------------------------------------- |
---|
873 | itcl::body Rappture::VideoScreen::togglePtrBind {pbvar} { |
---|
874 | |
---|
875 | if {[string compare $pbvar current] == 0} { |
---|
876 | set pbvar [whatPtrCtrl] |
---|
877 | } |
---|
878 | |
---|
879 | if {[string compare $pbvar rectangle] == 0} { |
---|
880 | |
---|
881 | # Bindings for selecting rectangle |
---|
882 | $itk_component(main) configure -cursor "" |
---|
883 | |
---|
884 | bind $itk_component(main) <ButtonPress-1> \ |
---|
885 | [itcl::code $this Rubberband new %W %x %y] |
---|
886 | bind $itk_component(main) <B1-Motion> \ |
---|
887 | [itcl::code $this Rubberband drag %W %x %y] |
---|
888 | bind $itk_component(main) <ButtonRelease-1> \ |
---|
889 | [itcl::code $this Rubberband release %W %x %y] |
---|
890 | |
---|
891 | } elseif {[string compare $pbvar measure] == 0} { |
---|
892 | |
---|
893 | # Bindings for measuring distance |
---|
894 | $itk_component(main) configure -cursor "" |
---|
895 | |
---|
896 | bind $itk_component(main) <ButtonPress-1> \ |
---|
897 | [itcl::code $this Measure new %W %x %y] |
---|
898 | bind $itk_component(main) <B1-Motion> \ |
---|
899 | [itcl::code $this Measure drag %W %x %y] |
---|
900 | bind $itk_component(main) <ButtonRelease-1> \ |
---|
901 | [itcl::code $this Measure release %W %x %y] |
---|
902 | |
---|
903 | } elseif {[string compare $pbvar particle] == 0} { |
---|
904 | |
---|
905 | # Bindings for marking particle locations |
---|
906 | $itk_component(main) configure -cursor "" |
---|
907 | |
---|
908 | bind $itk_component(main) <ButtonPress-1> \ |
---|
909 | [itcl::code $this Particle new %W %x %y] |
---|
910 | bind $itk_component(main) <B1-Motion> "" |
---|
911 | bind $itk_component(main) <ButtonRelease-1> "" |
---|
912 | |
---|
913 | |
---|
914 | } elseif {[string compare $pbvar object] == 0} { |
---|
915 | |
---|
916 | # Bindings for interacting with objects |
---|
917 | $itk_component(main) configure -cursor hand2 |
---|
918 | |
---|
919 | bind $itk_component(main) <ButtonPress-1> { } |
---|
920 | bind $itk_component(main) <B1-Motion> { } |
---|
921 | bind $itk_component(main) <ButtonRelease-1> { } |
---|
922 | |
---|
923 | } else { |
---|
924 | |
---|
925 | # invalid pointer mode |
---|
926 | |
---|
927 | } |
---|
928 | } |
---|
929 | |
---|
930 | |
---|
931 | |
---|
932 | |
---|
933 | |
---|
934 | ###### DRAWING TOOLS ##### |
---|
935 | |
---|
936 | |
---|
937 | |
---|
938 | |
---|
939 | |
---|
940 | # ---------------------------------------------------------------------- |
---|
941 | # Rubberband - draw a rubberband around something in the canvas |
---|
942 | # ---------------------------------------------------------------------- |
---|
943 | itcl::body Rappture::VideoScreen::Rubberband {status win x y} { |
---|
944 | switch -- $status { |
---|
945 | "new" { |
---|
946 | $win delete "rubbershape" |
---|
947 | set _x0 $x |
---|
948 | set _y0 $y |
---|
949 | $win create rectangle \ |
---|
950 | $x $y $x $y -outline white -width 2 \ |
---|
951 | -tags "rubbershape" -dash {4 4} |
---|
952 | } |
---|
953 | "drag" { |
---|
954 | foreach { x0 y0 x1 y1 } [$win coords "rubbershape"] break |
---|
955 | |
---|
956 | if {$_x0 > $x} { |
---|
957 | # backward direction |
---|
958 | set x0 $x |
---|
959 | set x1 $_x0 |
---|
960 | } else { |
---|
961 | set x1 $x |
---|
962 | } |
---|
963 | |
---|
964 | if {$_y0 >= $y} { |
---|
965 | # backward direction |
---|
966 | set y0 $y |
---|
967 | set y1 $_y0 |
---|
968 | } else { |
---|
969 | set y1 $y |
---|
970 | } |
---|
971 | |
---|
972 | eval $win coords "rubbershape" [list $x0 $y0 $x1 $y1] |
---|
973 | } |
---|
974 | "release" { |
---|
975 | Rubberband drag $win $x $y |
---|
976 | } |
---|
977 | default { |
---|
978 | error "bad status \"$status\": should be new, drag, or release" |
---|
979 | } |
---|
980 | } |
---|
981 | } |
---|
982 | |
---|
983 | # ---------------------------------------------------------------------- |
---|
984 | # Measure - draw a line to measure something on the canvas, |
---|
985 | # when user releases the line, user is given the |
---|
986 | # calculated measurement. |
---|
987 | # ---------------------------------------------------------------------- |
---|
988 | itcl::body Rappture::VideoScreen::Measure {status win x y} { |
---|
989 | switch -- $status { |
---|
990 | "new" { |
---|
991 | set name "measure[incr _counters(measure)]" |
---|
992 | |
---|
993 | set _obj [Rappture::VideoDistance $itk_component(main).$name $name $win \ |
---|
994 | -fncallback [itcl::code $this query framenum] \ |
---|
995 | -bindentercb [itcl::code $this togglePtrBind object] \ |
---|
996 | -bindleavecb [itcl::code $this togglePtrBind current] \ |
---|
997 | -writetextcb [itcl::code $this writeText] \ |
---|
998 | -ondelete [itcl::code $itk_component(dialminor) mark remove $name] \ |
---|
999 | -onframe [itcl::code $itk_component(dialminor) mark add $name] \ |
---|
1000 | -px2dist [itcl::scope _px2dist] \ |
---|
1001 | -units "m" \ |
---|
1002 | -color green \ |
---|
1003 | -bindings disable] |
---|
1004 | ${_obj} Coords $x $y $x $y |
---|
1005 | ${_obj} Show object |
---|
1006 | lappend _measurements ${_obj} |
---|
1007 | } |
---|
1008 | "drag" { |
---|
1009 | # FIXME: something wrong with the bindings, if the objects menu is |
---|
1010 | # open, and you click on the canvas off the menu, a "drag" |
---|
1011 | # or "release" call is made. need to figure out how to |
---|
1012 | # disable bindings while obj's menu is open. for now |
---|
1013 | # we set _obj to "" when we are finished creating it and |
---|
1014 | # check to see if it's valid when we do a drag or release |
---|
1015 | |
---|
1016 | if {"" == ${_obj}} { |
---|
1017 | return |
---|
1018 | } |
---|
1019 | |
---|
1020 | ${_obj} Coords [lreplace [${_obj} Coords] 2 3 $x $y] |
---|
1021 | } |
---|
1022 | "release" { |
---|
1023 | # if we enable ${_obj}'s bindings when we create it, |
---|
1024 | # probably never entered because the object's <Enter> |
---|
1025 | # bindings kick in before the window's release bindings do |
---|
1026 | |
---|
1027 | if {"" == ${_obj}} { |
---|
1028 | return |
---|
1029 | } |
---|
1030 | |
---|
1031 | Measure drag $win $x $y |
---|
1032 | |
---|
1033 | if {${_px2dist} == 0} { |
---|
1034 | ${_obj} Menu activate $x $y |
---|
1035 | } |
---|
1036 | ${_obj} configure -bindings enable |
---|
1037 | |
---|
1038 | set _obj "" |
---|
1039 | } |
---|
1040 | default { |
---|
1041 | error "bad status \"$status\": should be new, drag, or release" |
---|
1042 | } |
---|
1043 | } |
---|
1044 | } |
---|
1045 | |
---|
1046 | # ---------------------------------------------------------------------- |
---|
1047 | # Particle - mark a particle in the video, a new particle object is |
---|
1048 | # created from information like the name, which video |
---|
1049 | # frames it lives in, it's coords in the canvas in each |
---|
1050 | # frame, it's color... |
---|
1051 | # ---------------------------------------------------------------------- |
---|
1052 | itcl::body Rappture::VideoScreen::Particle {status win x y} { |
---|
1053 | switch -- $status { |
---|
1054 | "new" { |
---|
1055 | set name "particle[incr _counters(particle)]" |
---|
1056 | set _obj [Rappture::VideoParticle $itk_component(main).$name $name $win \ |
---|
1057 | -fncallback [itcl::code $this query framenum] \ |
---|
1058 | -bindentercb [itcl::code $this togglePtrBind object] \ |
---|
1059 | -bindleavecb [itcl::code $this togglePtrBind current] \ |
---|
1060 | -trajcallback [itcl::code $this Trajectory] \ |
---|
1061 | -ondelete [itcl::code $itk_component(dialminor) mark remove $name] \ |
---|
1062 | -onframe [itcl::code $itk_component(dialminor) mark add $name] \ |
---|
1063 | -framerange "0 ${_lastFrame}" \ |
---|
1064 | -halo 5 \ |
---|
1065 | -color green \ |
---|
1066 | -px2dist [itcl::scope _px2dist] \ |
---|
1067 | -units "m/s"] |
---|
1068 | ${_obj} Coords $x $y |
---|
1069 | ${_obj} Show object |
---|
1070 | #$itk_component(dialminor) mark add $name current |
---|
1071 | # bind $itk_component(hull) <<Frame>> [itcl::code $itk_component(main).$name UpdateFrame] |
---|
1072 | |
---|
1073 | # link the new particle to the last particle added, if it exists |
---|
1074 | set lastp [lindex ${_particles} end] |
---|
1075 | while {"" == [info commands $lastp]} { |
---|
1076 | set _particles [lreplace ${_particles} end end] |
---|
1077 | if {[llength ${_particles}] == 0} { |
---|
1078 | break |
---|
1079 | } |
---|
1080 | set lastp [lindex ${_particles} end] |
---|
1081 | } |
---|
1082 | if {"" != [info commands $lastp]} { |
---|
1083 | $lastp Link ${_obj} |
---|
1084 | } |
---|
1085 | |
---|
1086 | # add the particle to the list |
---|
1087 | lappend _particles ${_obj} |
---|
1088 | } |
---|
1089 | default { |
---|
1090 | error "bad status \"$status\": should be new" |
---|
1091 | } |
---|
1092 | } |
---|
1093 | } |
---|
1094 | |
---|
1095 | # ---------------------------------------------------------------------- |
---|
1096 | # Trajectory - draw a trajectory between two particles |
---|
1097 | # |
---|
1098 | # Trajectory $p0 $p1 |
---|
1099 | # ---------------------------------------------------------------------- |
---|
1100 | itcl::body Rappture::VideoScreen::Trajectory {args} { |
---|
1101 | |
---|
1102 | set nargs [llength $args] |
---|
1103 | if {($nargs != 1) && ($nargs != 2)} { |
---|
1104 | error "wrong # args: should be \"Trajectory p0 p1\"" |
---|
1105 | } |
---|
1106 | |
---|
1107 | set p0 "" |
---|
1108 | set p1 "" |
---|
1109 | foreach {p0 p1} $args break |
---|
1110 | |
---|
1111 | if {[string compare "" $p0] == 0} { |
---|
1112 | # p0 does not exist |
---|
1113 | return |
---|
1114 | } |
---|
1115 | |
---|
1116 | # remove any old trajectory links from p0 |
---|
1117 | set p0name [$p0 name] |
---|
1118 | set oldlink "vec-$p0name" |
---|
1119 | $itk_component(main) delete $oldlink |
---|
1120 | |
---|
1121 | # check to see if p1 exists anymore |
---|
1122 | if {[string compare "" $p1] == 0} { |
---|
1123 | # p1 does not exist |
---|
1124 | return |
---|
1125 | } |
---|
1126 | |
---|
1127 | foreach {x0 y0} [$p0 Coords] break |
---|
1128 | foreach {x1 y1} [$p1 Coords] break |
---|
1129 | set p1name [$p1 name] |
---|
1130 | set link "vec-$p0name-$p1name" |
---|
1131 | $itk_component(main) create line $x0 $y0 $x1 $y1 \ |
---|
1132 | -fill green \ |
---|
1133 | -width 2 \ |
---|
1134 | -tags "vector $link vec-$p0name" \ |
---|
1135 | -dash {4 4} \ |
---|
1136 | -arrow last |
---|
1137 | $itk_component(main) lower $link $p0name |
---|
1138 | |
---|
1139 | # calculate trajectory, truncate it after 4 sigdigs |
---|
1140 | set t [calculateTrajectory [$p0 Frame] $x0 $y0 [$p1 Frame] $x1 $y1] |
---|
1141 | set tt [string range $t 0 [expr [string first . $t] + 4]] |
---|
1142 | |
---|
1143 | |
---|
1144 | # calculate coords for text |
---|
1145 | foreach { x0 y0 x1 y1 } [$itk_component(main) bbox $link] break |
---|
1146 | set x [expr "$x0 + (abs($x1-$x0)/2)"] |
---|
1147 | set y [expr "$y0 + (abs($y1-$y0)/2)"] |
---|
1148 | |
---|
1149 | set tt "$tt m/s" |
---|
1150 | set tags "vectext $link vec-$p0name" |
---|
1151 | set width [expr sqrt(pow(abs($x1-$x0),2)+pow(abs($y1-$y0),2))] |
---|
1152 | |
---|
1153 | writeText $x $y $tt green $tags $width |
---|
1154 | return $link |
---|
1155 | } |
---|
1156 | |
---|
1157 | |
---|
1158 | # ---------------------------------------------------------------------- |
---|
1159 | # writeText - write text to the canvas |
---|
1160 | # writes text to the canvas in the color <color> at <x>,<y> |
---|
1161 | # writes text twice more offset up-left and down right, |
---|
1162 | # to add a shadowing effect so colors can be seen |
---|
1163 | # |
---|
1164 | # FIXME: Not sure how the text wrapped due to -width collides with the |
---|
1165 | # offset text. |
---|
1166 | # ---------------------------------------------------------------------- |
---|
1167 | itcl::body Rappture::VideoScreen::writeText {x y text color tags width} { |
---|
1168 | $itk_component(main) create text [expr $x-1] [expr $y] \ |
---|
1169 | -tags $tags \ |
---|
1170 | -justify center \ |
---|
1171 | -text $text \ |
---|
1172 | -fill black \ |
---|
1173 | -width $width |
---|
1174 | |
---|
1175 | $itk_component(main) create text [expr $x+1] [expr $y] \ |
---|
1176 | -tags $tags \ |
---|
1177 | -justify center \ |
---|
1178 | -text $text \ |
---|
1179 | -fill black \ |
---|
1180 | -width $width |
---|
1181 | |
---|
1182 | $itk_component(main) create text [expr $x] [expr $y-1] \ |
---|
1183 | -tags $tags \ |
---|
1184 | -justify center \ |
---|
1185 | -text $text \ |
---|
1186 | -fill black \ |
---|
1187 | -width $width |
---|
1188 | |
---|
1189 | $itk_component(main) create text [expr $x] [expr $y+1] \ |
---|
1190 | -tags $tags \ |
---|
1191 | -justify center \ |
---|
1192 | -text $text \ |
---|
1193 | -fill black \ |
---|
1194 | -width $width |
---|
1195 | |
---|
1196 | # # write text up-left |
---|
1197 | # $itk_component(main) create text [expr $x-1] [expr $y-1] \ |
---|
1198 | # -tags $tags \ |
---|
1199 | # -justify center \ |
---|
1200 | # -text $text \ |
---|
1201 | # -fill black \ |
---|
1202 | # -width $width |
---|
1203 | # |
---|
1204 | # # write text down-right |
---|
1205 | # $itk_component(main) create text [expr $x+1] [expr $y+1] \ |
---|
1206 | # -tags $tags \ |
---|
1207 | # -justify center \ |
---|
1208 | # -text $text \ |
---|
1209 | # -fill black \ |
---|
1210 | # -width $width |
---|
1211 | |
---|
1212 | # write text at x,y |
---|
1213 | $itk_component(main) create text $x $y \ |
---|
1214 | -tags $tags \ |
---|
1215 | -justify center \ |
---|
1216 | -text $text \ |
---|
1217 | -fill $color \ |
---|
1218 | -width $width |
---|
1219 | |
---|
1220 | } |
---|
1221 | |
---|
1222 | # ---------------------------------------------------------------------- |
---|
1223 | # calculateTrajectory - calculate the value of the trajectory |
---|
1224 | # ---------------------------------------------------------------------- |
---|
1225 | itcl::body Rappture::VideoScreen::calculateTrajectory {args} { |
---|
1226 | # set framerate 29.97 ;# frames per second |
---|
1227 | # set px2dist 8.00 ;# px per meter |
---|
1228 | |
---|
1229 | foreach {f0 x0 y0 f1 x1 y1} $args break |
---|
1230 | set px [expr sqrt(pow(abs($x1-$x0),2)+pow(abs($y1-$y0),2))] |
---|
1231 | set frames [expr $f1 - $f0] |
---|
1232 | |
---|
1233 | if {($frames != 0) && (${_px2dist} != 0)} { |
---|
1234 | set t [expr 1.0*$px/$frames*${_px2dist}*${_framerate}] |
---|
1235 | } else { |
---|
1236 | set t 0.0 |
---|
1237 | } |
---|
1238 | |
---|
1239 | return $t |
---|
1240 | } |
---|
1241 | |
---|
1242 | # ---------------------------------------------------------------------- |
---|
1243 | # toggleloop - add/remove a start/end loop mark to video dial. |
---|
1244 | # ---------------------------------------------------------------------- |
---|
1245 | itcl::body Rappture::VideoScreen::toggleloop {} { |
---|
1246 | if {$_settings(loop) == 0} { |
---|
1247 | $itk_component(dialminor) loop disable |
---|
1248 | } else { |
---|
1249 | set cur [${_movie} get position cur] |
---|
1250 | set end [${_movie} get position end] |
---|
1251 | |
---|
1252 | set startframe [expr $cur-10] |
---|
1253 | if {$startframe < 0} { |
---|
1254 | set startframe 0 |
---|
1255 | } |
---|
1256 | |
---|
1257 | set endframe [expr $cur+10] |
---|
1258 | if {$endframe > $end} { |
---|
1259 | set endframe $end |
---|
1260 | } |
---|
1261 | |
---|
1262 | $itk_component(dialminor) loop between $startframe $endframe |
---|
1263 | } |
---|
1264 | |
---|
1265 | } |
---|
1266 | |
---|
1267 | # ---------------------------------------------------------------------- |
---|
1268 | # OPTION: -width - width of the video |
---|
1269 | # ---------------------------------------------------------------------- |
---|
1270 | itcl::configbody Rappture::VideoScreen::width { |
---|
1271 | # $_dispatcher event -idle !fixsize |
---|
1272 | if {[string is integer $itk_option(-width)] == 0} { |
---|
1273 | error "bad value: \"$itk_option(-width)\": width should be an integer" |
---|
1274 | } |
---|
1275 | set _width $itk_option(-width) |
---|
1276 | after idle [itcl::code $this fixSize] |
---|
1277 | } |
---|
1278 | |
---|
1279 | # ---------------------------------------------------------------------- |
---|
1280 | # OPTION: -height - height of the video |
---|
1281 | # ---------------------------------------------------------------------- |
---|
1282 | itcl::configbody Rappture::VideoScreen::height { |
---|
1283 | # $_dispatcher event -idle !fixsize |
---|
1284 | if {[string is integer $itk_option(-height)] == 0} { |
---|
1285 | error "bad value: \"$itk_option(-height)\": height should be an integer" |
---|
1286 | } |
---|
1287 | set _height $itk_option(-height) |
---|
1288 | after idle [itcl::code $this fixSize] |
---|
1289 | } |
---|
1290 | |
---|
1291 | # ---------------------------------------------------------------------- |
---|
1292 | # OPTION: -fileopen |
---|
1293 | # ---------------------------------------------------------------------- |
---|
1294 | itcl::configbody Rappture::VideoScreen::fileopen { |
---|
1295 | $itk_component(fileopen) configure -command $itk_option(-fileopen) |
---|
1296 | } |
---|