Context Navigation

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

Last change on this file since 2025 was 2025, checked in by dkearney, 14 years ago
updated menus for video particle and video distance widgets, fixing interaction between video widgets, making the drawing tools more responsible for talking to the dial2 object.
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	set _frame $val
203
204	if {"" != $itk_option(-onframe)} {
205	uplevel \#0 $itk_option(-onframe) ${_frame}
206	}
207	} elseif {[llength $args] != 0} {
208	error "wrong # args: should be \"Frame ?<frameNumber>?\""
209	}
210	return ${_frame}
211	}
212
213	# ----------------------------------------------------------------------
214	# Coords ?<x0> <y0> <x1> <y1>? - update the coordinates of this object
215	# ----------------------------------------------------------------------
216	itcl::body Rappture::VideoDistance::Coords {args} {
217	if {[llength $args] == 0} {
218	return ${_coords}
219	} elseif {[llength $args] == 1} {
220	foreach {x0 y0 x1 y1} [lindex $args 0] break
221	} elseif {[llength $args] == 4} {
222	foreach {x0 y0 x1 y1} $args break
223	} else {
224	error "wrong # args: should be \"Coords ?<x0> <y0> <x1> <y1>?\""
225	}
226
227	if {([string is double $x0] != 1)} {
228	error "bad value: \"$x0\": x coordinate should be a double"
229	}
230	if {([string is double $y0] != 1)} {
231	error "bad value: \"$y0\": y coordinate should be a double"
232	}
233	if {([string is double $x1] != 1)} {
234	error "bad value: \"$x1\": x coordinate should be a double"
235	}
236	if {([string is double $y1] != 1)} {
237	error "bad value: \"$y1\": y coordinate should be a double"
238	}
239
240	set _coords [list $x0 $y0 $x1 $y1]
241
242	if {[llength [${_canvas} find withtag ${_name}-line]] > 0} {
243	eval ${_canvas} coords ${_name}-line ${_coords}
244	}
245
246	_fixValue
247	return ${_coords}
248	}
249
250	# ----------------------------------------------------------------------
251	# Enter - bindings if the mouse enters the object's space
252	# ----------------------------------------------------------------------
253	itcl::body Rappture::VideoDistance::Enter {} {
254	uplevel \#0 $bindentercb
255	}
256
257	# ----------------------------------------------------------------------
258	# Leave - bindings if the mouse leaves the object's space
259	# ----------------------------------------------------------------------
260	itcl::body Rappture::VideoDistance::Leave {} {
261	uplevel \#0 $bindleavecb
262	}
263
264
265	# ----------------------------------------------------------------------
266	# CatchEvent - bindings for caught events
267	# ----------------------------------------------------------------------
268	itcl::body Rappture::VideoDistance::CatchEvent {event} {
269	switch -- $event {
270	"Frame" {
271	if {[uplevel \#0 $fncallback] == ${_frame}} {
272	${_canvas} itemconfigure ${_name}-line -fill red
273	} else {
274	${_canvas} itemconfigure ${_name}-line -fill ${_color}
275	}
276	}
277	default {
278	error "bad event \"$event\": should be one of Frame."
279	}
280
281	}
282	}
283
284
285	# ----------------------------------------------------------------------
286	# Show - put properties of the object on the canvas
287	# object - draw the object on the canvas
288	# name - popup a ballon with the name of this object
289	# ----------------------------------------------------------------------
290	itcl::body Rappture::VideoDistance::Show {args} {
291	set option [lindex $args 0]
292	switch -- $option {
293	"object" {
294	if {[llength $args] != 1} {
295	error "wrong # args: should be \"object\""
296	}
297	${_canvas} create line ${_coords} \
298	-fill ${_color}\
299	-width 2 \
300	-tags "measure ${_name} ${_name}-line" \
301	-dash {4 4} \
302	-arrow both
303	}
304	"name" {
305
306	}
307	default {
308	error "bad option \"$option\": should be one of object, name."
309	}
310	}
311	}
312
313	# ----------------------------------------------------------------------
314	# Hide
315	# object - remove the particle from where it is drawn
316	# name - remove the popup with the name
317	# ----------------------------------------------------------------------
318	itcl::body Rappture::VideoDistance::Hide {args} {
319	set option [lindex $args 0]
320	switch -- $option {
321	"object" {
322	if {[llength $args] != 1} {
323	error "wrong # args: should be \"object\""
324	}
325	${_canvas} delete "${_name}"
326	}
327	"name" {
328
329	}
330	default {
331	error "bad option \"$option\": should be one of object, name."
332	}
333	}
334	}
335
336	# ----------------------------------------------------------------------
337	# Move - move the object to a new location
338	# ----------------------------------------------------------------------
339	itcl::body Rappture::VideoDistance::Move {status x y} {
340	switch -- $status {
341	"press" {
342	set _x $x
343	set _y $y
344	}
345	"motion" {
346	${_canvas} move ${_name} [expr $x-${_x}] [expr $y-${_y}]
347	set _coords [${_canvas} coords ${_name}-line]
348	set _x $x
349	set _y $y
350	}
351	"release" {
352	}
353	default {
354	error "bad option \"$option\": should be one of press, motion, release."
355	}
356	}
357	}
358
359	# ----------------------------------------------------------------------
360	# Menu - popup a menu with the particle controls
361	# create
362	# activate x y
363	# deactivate status
364	# ----------------------------------------------------------------------
365	itcl::body Rappture::VideoDistance::Menu {args} {
366	set option [lindex $args 0]
367	switch -- $option {
368	"activate" {
369	if {[llength $args] != 3} {
370	error "wrong # args: should be \"activate <x> <y>\""
371	}
372	foreach {x y} [lrange $args 1 end] break
373	set dir "left"
374	set x0 [winfo rootx ${_canvas}]
375	set y0 [winfo rooty ${_canvas}]
376	set w0 [winfo width ${_canvas}]
377	set h0 [winfo height ${_canvas}]
378	set x [expr $x0+$x]
379	set y [expr $y0+$y]
380	$itk_component(menu) activate @$x,$y $dir
381
382	# update the values in the menu
383	set controls [$itk_component(menu) component inner]
384	foreach {x0 y0 x1 y1} ${_coords} break
385	$controls.measuremente delete 0 end
386	$controls.measuremente insert 0 "${_dist} ${_units}"
387	$controls.framenume value ${_frame}
388	$controls.x0e value $x0
389	$controls.y0e value $y0
390	$controls.x1e value $x1
391	$controls.y1e value $y1
392	$controls.deleteb value false
393	}
394	"deactivate" {
395	$itk_component(menu) deactivate
396	if {[llength $args] != 2} {
397	error "wrong # args: should be \"deactivate <status>\""
398	}
399	set status [lindex $args 1]
400	switch -- $status {
401	"save" {
402	set controls [$itk_component(menu) component inner]
403
404	set newframenum [$controls.framenume value]
405	if {${_frame} != $newframenum} {
406	Frame $newframenum
407	}
408
409	foreach {oldx0 oldy0 oldx1 oldy1} ${_coords} break
410	set newx0 [$controls.x0e value]
411	set newy0 [$controls.y0e value]
412	set newx1 [$controls.x1e value]
413	set newy1 [$controls.y1e value]
414
415	if {$oldx0 != $newx0 \|\|
416	$oldy0 != $newy0 \|\|
417	$oldx1 != $newx1 \|\|
418	$oldy1 != $newy1} {
419
420	Coords $newx0 $newy0 $newx1 $newy1
421	}
422
423	set newdist [Rappture::Units::convert \
424	[$controls.measuremente get] \
425	-context ${_units} -units off]
426
427	if {$newdist != ${_dist}} {
428	# update the distance displayed
429
430	set px [expr sqrt(pow(($newx1-$newx0),2)+pow(($newy1-$newy0),2))]
431	set px2dist [expr $newdist/$px]
432
433	_fixPx2Dist $px2dist
434	}
435
436	if {[$controls.deleteb value]} {
437	itcl::delete object $this
438	}
439	}
440	"cancel" {
441	}
442	"default" {
443	error "bad value \"$status\": should be one of save, cancel"
444	}
445	}
446	}
447	default {
448	error "bad option \"$option\": should be one of activate, deactivate."
449	}
450	}
451	}
452
453	# ----------------------------------------------------------------------
454	# _fixBindings - enable/disable bindings
455	# enable
456	# disable
457	# ----------------------------------------------------------------------
458	itcl::body Rappture::VideoDistance::_fixBindings {status} {
459	switch -- $status {
460	"enable" {
461	${_canvas} bind ${_name} <ButtonPress-1> [itcl::code $this Move press %x %y]
462	${_canvas} bind ${_name} <B1-Motion> [itcl::code $this Move motion %x %y]
463	${_canvas} bind ${_name} <ButtonRelease-1> [itcl::code $this Move release %x %y]
464
465	${_canvas} bind ${_name} <ButtonPress-3> [itcl::code $this Menu activate %x %y]
466
467	${_canvas} bind ${_name} <Enter> [itcl::code $this Enter]
468	${_canvas} bind ${_name} <Leave> [itcl::code $this Leave]
469
470	${_canvas} bind ${_name} <B1-Enter> { }
471	${_canvas} bind ${_name} <B1-Leave> { }
472	bindtags ${_canvas} [concat "${_name}-FrameEvent" [bindtags ${_canvas}]]
473	}
474	"disable" {
475	${_canvas} bind ${_name} <ButtonPress-1> { }
476	${_canvas} bind ${_name} <B1-Motion> { }
477	${_canvas} bind ${_name} <ButtonRelease-1> { }
478
479	${_canvas} bind ${_name} <ButtonPress-3> { }
480
481	${_canvas} bind ${_name} <Enter> { }
482	${_canvas} bind ${_name} <Leave> { }
483
484	${_canvas} bind ${_name} <B1-Enter> { }
485	${_canvas} bind ${_name} <B1-Leave> { }
486	set tagnum [lsearch [bindtags ${_canvas}] "${_name}-FrameEvent"]
487	if {$tagnum >= 0} {
488	bindtags ${_canvas} [lreplace [bindtags ${_canvas}] $tagnum $tagnum]
489	}
490	}
491	default {
492	error "bad option \"$status\": should be one of enable, disable."
493	}
494	}
495	}
496
497	# ----------------------------------------------------------------------
498	# USAGE: _fixPx2Dist
499	# Invoked whenever the value for this object is changed by the user
500	# via the popup menu.
501	# ----------------------------------------------------------------------
502	itcl::body Rappture::VideoDistance::_fixPx2Dist {px2dist} {
503	if {"" == $itk_option(-px2dist)} {
504	return
505	}
506	upvar #0 $itk_option(-px2dist) var
507	set var $px2dist
508	}
509
510
511	# ----------------------------------------------------------------------
512	# USAGE: _fixValue
513	# Invoked automatically whenever the -px2dist associated with this
514	# widget is modified. Copies the value to the current settings for
515	# the widget.
516	# ----------------------------------------------------------------------
517	itcl::body Rappture::VideoDistance::_fixValue {args} {
518	if {"" == $itk_option(-px2dist)} {
519	return
520	}
521	upvar #0 $itk_option(-px2dist) var
522
523	if {"" == ${_coords}} {
524	# no coords, skip calculation
525	return
526	}
527
528	# calculate the length
529	foreach {x0 y0 x1 y1} ${_coords} break
530	set px [expr sqrt(pow(($x1-$x0),2)+pow(($y1-$y0),2))]
531	set _dist [expr $px*$var]
532
533	# run the new value through units conversion to round
534	# it off so when we show it in the menu and compare it
535	# to the value that comes back from the menu, we don't
536	# get differences in value due to rounding.
537	set _dist [Rappture::Units::convert ${_dist} -context ${_units} -units off]
538
539	set x [expr "$x0 + (($x1-$x0)/2)"]
540	set y [expr "$y0 + (($y1-$y0)/2)"]
541
542	set tt "${_dist} ${_units}"
543	set tags "meastext ${_name} ${_name}-val"
544	set width [expr sqrt(pow(abs($x1-$x0),2)+pow(abs($y1-$y0),2))]
545	set args [list $x $y "$tt" "${_color}" "$tags" $width]
546
547	# remove old text
548	${_canvas} delete ${_name}-val
549
550	set controls [$itk_component(menu) component inner]
551	if {![$controls.deleteb value]} {
552	# if the object is not hidden, write _dist to the canvas
553	uplevel \#0 $writetextcb $args
554	}
555	}
556
557
558	# ----------------------------------------------------------------------
559	# CONFIGURATION OPTION: -color
560	# ----------------------------------------------------------------------
561	itcl::configbody Rappture::VideoDistance::color {
562	if {[string compare "" $itk_option(-color)] != 0} {
563	# FIXME how to tell if the color is valid?
564	set _color $itk_option(-color)
565	} else {
566	error "bad value: \"$itk_option(-color)\": should be a valid color"
567	}
568	}
569
570	# ----------------------------------------------------------------------
571	# CONFIGURE: -px2dist
572	# ----------------------------------------------------------------------
573	itcl::configbody Rappture::VideoDistance::px2dist {
574	if {"" != $_px2dist} {
575	upvar #0 $_px2dist var
576	trace remove variable var write [itcl::code $this _fixValue]
577	}
578
579	set _px2dist $itk_option(-px2dist)
580
581	if {"" != $_px2dist} {
582	upvar #0 $_px2dist var
583	trace add variable var write [itcl::code $this _fixValue]
584
585	# sync to the current value of this variable
586	if {[info exists var]} {
587	_fixValue
588	}
589	}
590	}
591
592	# ----------------------------------------------------------------------
593	# CONFIGURE: -units
594	# ----------------------------------------------------------------------
595	itcl::configbody Rappture::VideoDistance::units {
596	set _units $itk_option(-units)
597	# _fixValue
598	}
599
600
601	# ----------------------------------------------------------------------
602	# CONFIGURE: -bindings
603	# ----------------------------------------------------------------------
604	itcl::configbody Rappture::VideoDistance::bindings {
605	_fixBindings $itk_option(-bindings)
606	}
607	# ----------------------------------------------------------------------

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

Download in other formats: