Context Navigation

source: branches/1.3/gui/scripts/videodistance.tcl @ 4552

Last change on this file since 4552 was 3330, checked in by gah, 12 years ago
merge (by hand) with Rappture1.2 branch
File size: 21.5 KB

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

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

Download in other formats: