Context Navigation

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

Last change on this file since 3177 was 3177, checked in by mmc, 12 years ago
Updated all of the copyright notices to reference the transfer to the new HUBzero Foundation, LLC.
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) 2004-2012 HUBzero Foundation, LLC
7	#
8	# See the file "license.terms" for information on usage and redistribution of
9	# this file, and for a DISCLAIMER OF ALL WARRANTIES.
10	# ======================================================================
11
12	package require Itk
13	package require BLT
14	package require Img
15	package require Rappture
16	package require RapptureGUI
17
18	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: