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