Context Navigation

source: trunk/gui/scripts/videodistance.tcl @ 3093

Last change on this file since 3093 was 2028, checked in by dkearney, 14 years ago
video widget updates various bug fixes
File size: 21.5 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: