Context Navigation

source: trunk/gui/scripts/vtkviewer.tcl @ 3074

Last change on this file since 3074 was 3072, checked in by gah, 12 years ago
fixes for drawingentry
File size: 68.6 KB

Line
1
2	# ----------------------------------------------------------------------
3	# COMPONENT: vtkviewer - Vtk drawing object viewer
4	#
5	# It connects to the Vtk server running on a rendering farm,
6	# transmits data, and displays the results.
7	# ======================================================================
8	# AUTHOR: Michael McLennan, Purdue University
9	# Copyright (c) 2004-2005 Purdue Research Foundation
10	#
11	# See the file "license.terms" for information on usage and
12	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13	# ======================================================================
14	package require Itk
15	package require BLT
16	#package require Img
17
18	option add *VtkViewer.width 4i widgetDefault
19	option add VtkViewercursor crosshair widgetDefault
20	option add *VtkViewer.height 4i widgetDefault
21	option add *VtkViewer.foreground black widgetDefault
22	option add *VtkViewer.controlBackground gray widgetDefault
23	option add *VtkViewer.controlDarkBackground #999999 widgetDefault
24	option add *VtkViewer.plotBackground black widgetDefault
25	option add *VtkViewer.plotForeground white widgetDefault
26	option add *VtkViewer.font \
27	--helvetica-medium-r-normal--12-* widgetDefault
28
29	# must use this name -- plugs into Rappture::resources::load
30	proc VtkViewer_init_resources {} {
31	Rappture::resources::register \
32	vtkvis_server Rappture::VtkViewer::SetServerList
33	}
34
35	itcl::class Rappture::VtkViewer {
36	inherit Rappture::VisViewer
37
38	itk_option define -plotforeground plotForeground Foreground ""
39	itk_option define -plotbackground plotBackground Background ""
40
41	constructor { hostlist args } {
42	Rappture::VisViewer::constructor $hostlist
43	} {
44	# defined below
45	}
46	destructor {
47	# defined below
48	}
49	public proc SetServerList { namelist } {
50	Rappture::VisViewer::SetServerList "vtkvis" $namelist
51	}
52	public method add {dataobj {settings ""}}
53	public method camera {option args}
54	public method delete {args}
55	public method disconnect {}
56	public method download {option args}
57	public method get {args}
58	public method isconnected {}
59	public method limits { colormap }
60	public method sendto { string }
61	public method parameters {title args} {
62	# do nothing
63	}
64	public method scale {args}
65
66	protected method Connect {}
67	protected method CurrentDatasets {args}
68	protected method Disconnect {}
69	protected method DoResize {}
70	protected method DoRotate {}
71	protected method AdjustSetting {what {value ""}}
72	protected method FixSettings { args }
73	protected method Pan {option x y}
74	protected method Pick {x y}
75	protected method Rebuild {}
76	protected method ReceiveDataset { args }
77	protected method ReceiveImage { args }
78	protected method ReceiveLegend { colormap title vmin vmax size }
79	protected method Rotate {option x y}
80	protected method SendCmd {string}
81	protected method Zoom {option}
82
83	# The following methods are only used by this class.
84	private method BuildAxisTab {}
85	private method BuildCameraTab {}
86	private method BuildColormap { colormap dataobj comp }
87	private method BuildCutawayTab {}
88	private method BuildDownloadPopup { widget command }
89	private method BuildVolumeTab {}
90	private method ConvertToVtkData { dataobj comp }
91	private method DrawLegend {}
92	private method EnterLegend { x y }
93	private method EventuallyResize { w h }
94	private method EventuallyRotate { q }
95	private method GetImage { args }
96	private method GetVtkData { args }
97	private method IsValidObject { dataobj }
98	private method LeaveLegend {}
99	private method MotionLegend { x y }
100	private method PanCamera {}
101	private method RequestLegend {}
102	private method SetColormap { dataobj comp }
103	private method SetLegendTip { x y }
104	private method SetObjectStyle { dataobj comp }
105	private method Slice {option args}
106
107	private variable _arcball ""
108	private variable _outbuf ;# buffer for outgoing commands
109
110	private variable _dlist "" ;# list of data objects
111	private variable _allDataObjs
112	private variable _obj2datasets
113	private variable _obj2ovride ;# maps dataobj => style override
114	private variable _datasets ;# contains all the dataobj-component
115	;# datasets in the server
116	private variable _colormaps ;# contains all the colormaps
117	;# in the server.
118	private variable _dataset2style ;# maps dataobj-component to transfunc
119	private variable _style2datasets ;# maps tf back to list of
120	# dataobj-components using the tf.
121
122	private variable _click ;# info used for rotate operations
123	private variable _limits ;# autoscale min/max for all axes
124	private variable _view ;# view params for 3D view
125	private variable _settings
126	private variable _volume
127	private variable _axis
128	private variable _reset 1 ;# indicates if camera needs to be reset
129	# to starting position.
130	private variable _haveGlyphs 0
131
132	private variable _first "" ;# This is the topmost dataset.
133	private variable _start 0
134	private variable _buffering 0
135	private variable _title ""
136
137	common _downloadPopup ;# download options from popup
138	private common _hardcopy
139	private variable _width 0
140	private variable _height 0
141	private variable _resizePending 0
142	private variable _rotatePending 0
143	private variable _outline
144	}
145
146	itk::usual VtkViewer {
147	keep -background -foreground -cursor -font
148	keep -plotbackground -plotforeground
149	}
150
151	# ----------------------------------------------------------------------
152	# CONSTRUCTOR
153	# ----------------------------------------------------------------------
154	itcl::body Rappture::VtkViewer::constructor {hostlist args} {
155	package require vtk
156	set _serverType "vtkvis"
157
158	# Rebuild event
159	$_dispatcher register !rebuild
160	$_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
161
162	# Resize event
163	$_dispatcher register !resize
164	$_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
165
166	# Rotate event
167	$_dispatcher register !rotate
168	$_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
169
170	set _outbuf ""
171
172	#
173	# Populate parser with commands handle incoming requests
174	#
175	$_parser alias image [itcl::code $this ReceiveImage]
176	$_parser alias dataset [itcl::code $this ReceiveDataset]
177	$_parser alias legend [itcl::code $this ReceiveLegend]
178
179	array set _outline {
180	id -1
181	afterId -1
182	x1 -1
183	y1 -1
184	x2 -1
185	y2 -1
186	}
187	# Initialize the view to some default parameters.
188	array set _view {
189	qw 1
190	qx 0
191	qy 0
192	qz 0
193	zoom 1.0
194	xpan 0
195	ypan 0
196	ortho 0
197	}
198	set _arcball [blt::arcball create 100 100]
199	set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
200	$_arcball quaternion $q
201
202	set _limits(zmin) 0.0
203	set _limits(zmax) 1.0
204
205	array set _axis [subst {
206	xgrid 0
207	ygrid 0
208	zgrid 0
209	xcutaway 0
210	ycutaway 0
211	zcutaway 0
212	xposition 0
213	yposition 0
214	zposition 0
215	xdirection -1
216	ydirection -1
217	zdirection -1
218	visible 1
219	labels 1
220	}]
221	array set _volume [subst {
222	edges 1
223	lighting 1
224	opacity 40
225	visible 1
226	wireframe 0
227	}]
228	array set _settings [subst {
229	legend 1
230	}]
231
232	itk_component add view {
233	canvas $itk_component(plotarea).view \
234	-highlightthickness 0 -borderwidth 0
235	} {
236	usual
237	ignore -highlightthickness -borderwidth -background
238	}
239
240	set c $itk_component(view)
241	bind $c <Configure> [itcl::code $this EventuallyResize %w %h]
242	bind $c <4> [itcl::code $this Zoom in 0.25]
243	bind $c <5> [itcl::code $this Zoom out 0.25]
244	bind $c <KeyPress-Left> [list %W xview scroll 10 units]
245	bind $c <KeyPress-Right> [list %W xview scroll -10 units]
246	bind $c <KeyPress-Up> [list %W yview scroll 10 units]
247	bind $c <KeyPress-Down> [list %W yview scroll -10 units]
248	bind $c <Enter> "focus %W"
249
250	# Fix the scrollregion in case we go off screen
251	$c configure -scrollregion [$c bbox all]
252
253	set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
254	set _map(cwidth) -1
255	set _map(cheight) -1
256	set _map(zoom) 1.0
257	set _map(original) ""
258
259	set f [$itk_component(main) component controls]
260	itk_component add reset {
261	button $f.reset -borderwidth 1 -padx 1 -pady 1 \
262	-highlightthickness 0 \
263	-image [Rappture::icon reset-view] \
264	-command [itcl::code $this Zoom reset]
265	} {
266	usual
267	ignore -highlightthickness
268	}
269	pack $itk_component(reset) -side top -padx 2 -pady 2
270	Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
271
272	itk_component add zoomin {
273	button $f.zin -borderwidth 1 -padx 1 -pady 1 \
274	-highlightthickness 0 \
275	-image [Rappture::icon zoom-in] \
276	-command [itcl::code $this Zoom in]
277	} {
278	usual
279	ignore -highlightthickness
280	}
281	pack $itk_component(zoomin) -side top -padx 2 -pady 2
282	Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
283
284	itk_component add zoomout {
285	button $f.zout -borderwidth 1 -padx 1 -pady 1 \
286	-highlightthickness 0 \
287	-image [Rappture::icon zoom-out] \
288	-command [itcl::code $this Zoom out]
289	} {
290	usual
291	ignore -highlightthickness
292	}
293	pack $itk_component(zoomout) -side top -padx 2 -pady 2
294	Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
295
296	BuildVolumeTab
297	BuildAxisTab
298	BuildCutawayTab
299	BuildCameraTab
300
301	# Legend
302
303	set _image(legend) [image create photo]
304	itk_component add legend {
305	canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0
306	} {
307	usual
308	ignore -highlightthickness
309	rename -background -plotbackground plotBackground Background
310	}
311
312	# Hack around the Tk panewindow. The problem is that the requested
313	# size of the 3d view isn't set until an image is retrieved from
314	# the server. So the panewindow uses the tiny size.
315	set w 10000
316	pack forget $itk_component(view)
317	blt::table $itk_component(plotarea) \
318	0,0 $itk_component(view) -fill both -reqwidth $w
319	blt::table configure $itk_component(plotarea) c1 -resize none
320
321	# Bindings for rotation via mouse
322	bind $itk_component(view) <ButtonPress-1> \
323	[itcl::code $this Rotate click %x %y]
324	bind $itk_component(view) <B1-Motion> \
325	[itcl::code $this Rotate drag %x %y]
326	bind $itk_component(view) <ButtonRelease-1> \
327	[itcl::code $this Rotate release %x %y]
328	bind $itk_component(view) <Configure> \
329	[itcl::code $this EventuallyResize %w %h]
330
331	if 0 {
332	bind $itk_component(view) <Configure> \
333	[itcl::code $this EventuallyResize %w %h]
334	}
335	# Bindings for panning via mouse
336	bind $itk_component(view) <ButtonPress-2> \
337	[itcl::code $this Pan click %x %y]
338	bind $itk_component(view) <B2-Motion> \
339	[itcl::code $this Pan drag %x %y]
340	bind $itk_component(view) <ButtonRelease-2> \
341	[itcl::code $this Pan release %x %y]
342
343	bind $itk_component(view) <ButtonRelease-3> \
344	[itcl::code $this Pick %x %y]
345
346	# Bindings for panning via keyboard
347	bind $itk_component(view) <KeyPress-Left> \
348	[itcl::code $this Pan set -10 0]
349	bind $itk_component(view) <KeyPress-Right> \
350	[itcl::code $this Pan set 10 0]
351	bind $itk_component(view) <KeyPress-Up> \
352	[itcl::code $this Pan set 0 -10]
353	bind $itk_component(view) <KeyPress-Down> \
354	[itcl::code $this Pan set 0 10]
355	bind $itk_component(view) <Shift-KeyPress-Left> \
356	[itcl::code $this Pan set -2 0]
357	bind $itk_component(view) <Shift-KeyPress-Right> \
358	[itcl::code $this Pan set 2 0]
359	bind $itk_component(view) <Shift-KeyPress-Up> \
360	[itcl::code $this Pan set 0 -2]
361	bind $itk_component(view) <Shift-KeyPress-Down> \
362	[itcl::code $this Pan set 0 2]
363
364	# Bindings for zoom via keyboard
365	bind $itk_component(view) <KeyPress-Prior> \
366	[itcl::code $this Zoom out]
367	bind $itk_component(view) <KeyPress-Next> \
368	[itcl::code $this Zoom in]
369
370	bind $itk_component(view) <Enter> "focus $itk_component(view)"
371
372	if {[string equal "x11" [tk windowingsystem]]} {
373	# Bindings for zoom via mouse
374	bind $itk_component(view) <4> [itcl::code $this Zoom out]
375	bind $itk_component(view) <5> [itcl::code $this Zoom in]
376	}
377
378	set _image(download) [image create photo]
379
380	eval itk_initialize $args
381	Connect
382	}
383
384	# ----------------------------------------------------------------------
385	# DESTRUCTOR
386	# ----------------------------------------------------------------------
387	itcl::body Rappture::VtkViewer::destructor {} {
388	Disconnect
389	$_dispatcher cancel !rebuild
390	$_dispatcher cancel !resize
391	$_dispatcher cancel !rotate
392	image delete $_image(plot)
393	image delete $_image(download)
394	catch { blt::arcball destroy $_arcball }
395	}
396
397	itcl::body Rappture::VtkViewer::DoResize {} {
398	if { $_width < 2 } {
399	set _width 500
400	}
401	if { $_height < 2 } {
402	set _height 500
403	}
404	set _start [clock clicks -milliseconds]
405	SendCmd "screen size $_width $_height"
406	#SendCmd "imgflush"
407
408	# Must reset camera to have object scaling to take effect.
409	#SendCmd "camera reset"
410	#SendCmd "camera zoom $_view(zoom)"
411	set _resizePending 0
412	}
413
414	itcl::body Rappture::VtkViewer::DoRotate {} {
415	set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
416	SendCmd "camera orient $q"
417	set _rotatePending 0
418	}
419
420	itcl::body Rappture::VtkViewer::EventuallyResize { w h } {
421	set _width $w
422	set _height $h
423	$_arcball resize $w $h
424	if { !$_resizePending } {
425	set _resizePending 1
426	$_dispatcher event -after 200 !resize
427	}
428	}
429
430	set rotate_delay 150
431
432	itcl::body Rappture::VtkViewer::EventuallyRotate { q } {
433	foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break
434	if { !$_rotatePending } {
435	set _rotatePending 1
436	global rotate_delay
437	$_dispatcher event -after $rotate_delay !rotate
438	}
439	}
440
441	# ----------------------------------------------------------------------
442	# USAGE: add <dataobj> ?<settings>?
443	#
444	# Clients use this to add a data object to the plot. The optional
445	# <settings> are used to configure the plot. Allowed settings are
446	# -color, -brightness, -width, -linestyle, and -raise.
447	# ----------------------------------------------------------------------
448	itcl::body Rappture::VtkViewer::add {dataobj {settings ""}} {
449	array set params {
450	-color auto
451	-width 1
452	-linestyle solid
453	-brightness 0
454	-raise 0
455	-description ""
456	-param ""
457	-type ""
458	}
459	array set params $settings
460	set params(-description) ""
461	set params(-param) ""
462	foreach {opt val} $settings {
463	if {![info exists params($opt)]} {
464	error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
465	}
466	set params($opt) $val
467	}
468	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
469	# can't handle -autocolors yet
470	set params(-color) black
471	}
472	set pos [lsearch -exact $dataobj $_dlist]
473	if {$pos < 0} {
474	lappend _dlist $dataobj
475	}
476	set _allDataObjs($dataobj) 1
477	set _obj2ovride($dataobj-color) $params(-color)
478	set _obj2ovride($dataobj-width) $params(-width)
479	set _obj2ovride($dataobj-raise) $params(-raise)
480	$_dispatcher event -idle !rebuild
481	}
482
483
484	# ----------------------------------------------------------------------
485	# USAGE: delete ?<dataobj1> <dataobj2> ...?
486	#
487	# Clients use this to delete a dataobj from the plot. If no dataobjs
488	# are specified, then all dataobjs are deleted. No data objects are
489	# deleted. They are only removed from the display list.
490	#
491	# ----------------------------------------------------------------------
492	itcl::body Rappture::VtkViewer::delete {args} {
493	if { [llength $args] == 0} {
494	set args $_dlist
495	}
496	# Delete all specified dataobjs
497	set changed 0
498	foreach dataobj $args {
499	set pos [lsearch -exact $_dlist $dataobj]
500	if { $pos < 0 } {
501	continue; # Don't know anything about it.
502	}
503	# Remove it from the dataobj list.
504	set _dlist [lreplace $_dlist $pos $pos]
505	foreach comp [$dataobj components] {
506	SendCmd "dataset visible 0 $dataobj-$comp"
507	}
508	array unset _obj2ovride $dataobj-*
509	# Append to the end of the dataobj list.
510	lappend _dlist $dataobj
511	set changed 1
512	}
513	# If anything changed, then rebuild the plot
514	if { $changed } {
515	$_dispatcher event -idle !rebuild
516	}
517	}
518
519	# ----------------------------------------------------------------------
520	# USAGE: get ?-objects?
521	# USAGE: get ?-visible?
522	# USAGE: get ?-image view?
523	#
524	# Clients use this to query the list of objects being plotted, in
525	# order from bottom to top of this result. The optional "-image"
526	# flag can also request the internal images being shown.
527	# ----------------------------------------------------------------------
528	itcl::body Rappture::VtkViewer::get {args} {
529	if {[llength $args] == 0} {
530	set args "-objects"
531	}
532
533	set op [lindex $args 0]
534	switch -- $op {
535	"-objects" {
536	# put the dataobj list in order according to -raise options
537	set dlist {}
538	foreach dataobj $_dlist {
539	if { ![IsValidObject $dataobj] } {
540	continue
541	}
542	if {[info exists _obj2ovride($dataobj-raise)] &&
543	$_obj2ovride($dataobj-raise)} {
544	set dlist [linsert $dlist 0 $dataobj]
545	} else {
546	lappend dlist $dataobj
547	}
548	}
549	return $dlist
550	}
551	"-visible" {
552	set dlist {}
553	foreach dataobj $_dlist {
554	if { ![IsValidObject $dataobj] } {
555	continue
556	}
557	if { ![info exists _obj2ovride($dataobj-raise)] } {
558	# No setting indicates that the object isn't invisible.
559	continue
560	}
561	# Otherwise use the -raise parameter to put the object to
562	# the front of the list.
563	if { $_obj2ovride($dataobj-raise) } {
564	set dlist [linsert $dlist 0 $dataobj]
565	} else {
566	lappend dlist $dataobj
567	}
568	}
569	return $dlist
570	}
571	-image {
572	if {[llength $args] != 2} {
573	error "wrong # args: should be \"get -image view\""
574	}
575	switch -- [lindex $args end] {
576	view {
577	return $_image(plot)
578	}
579	default {
580	error "bad image name \"[lindex $args end]\": should be view"
581	}
582	}
583	}
584	default {
585	error "bad option \"$op\": should be -objects or -image"
586	}
587	}
588	}
589
590	# ----------------------------------------------------------------------
591	# USAGE: scale ?<data1> <data2> ...?
592	#
593	# Sets the default limits for the overall plot according to the
594	# limits of the data for all of the given <data> objects. This
595	# accounts for all objects--even those not showing on the screen.
596	# Because of this, the limits are appropriate for all objects as
597	# the user scans through data in the ResultSet viewer.
598	# ----------------------------------------------------------------------
599	itcl::body Rappture::VtkViewer::scale {args} {
600	array unset _limits
601	foreach dataobj $args {
602	array set bounds [limits $dataobj]
603	if {![info exists _limits(xmin)] \|\| $_limits(xmin) > $bounds(xmin)} {
604	set _limits(xmin) $bounds(xmin)
605	}
606	if {![info exists _limits(xmax)] \|\| $_limits(xmax) < $bounds(xmax)} {
607	set _limits(xmax) $bounds(xmax)
608	}
609
610	if {![info exists _limits(ymin)] \|\| $_limits(ymin) > $bounds(ymin)} {
611	set _limits(ymin) $bounds(ymin)
612	}
613	if {![info exists _limits(ymax)] \|\| $_limits(ymax) < $bounds(ymax)} {
614	set _limits(ymax) $bounds(ymax)
615	}
616
617	if {![info exists _limits(zmin)] \|\| $_limits(zmin) > $bounds(zmin)} {
618	set _limits(zmin) $bounds(zmin)
619	}
620	if {![info exists _limits(zmax)] \|\| $_limits(zmax) < $bounds(zmax)} {
621	set _limits(zmax) $bounds(zmax)
622	}
623	}
624	}
625
626	# ----------------------------------------------------------------------
627	# USAGE: download coming
628	# USAGE: download controls <downloadCommand>
629	# USAGE: download now
630	#
631	# Clients use this method to create a downloadable representation
632	# of the plot. Returns a list of the form {ext string}, where
633	# "ext" is the file extension (indicating the type of data) and
634	# "string" is the data itself.
635	# ----------------------------------------------------------------------
636	itcl::body Rappture::VtkViewer::download {option args} {
637	switch $option {
638	coming {
639	if {[catch {
640	blt::winop snap $itk_component(plotarea) $_image(download)
641	}]} {
642	$_image(download) configure -width 1 -height 1
643	$_image(download) put #000000
644	}
645	}
646	controls {
647	set popup .vtkviewerdownload
648	if { ![winfo exists .vtkviewerdownload] } {
649	set inner [BuildDownloadPopup $popup [lindex $args 0]]
650	} else {
651	set inner [$popup component inner]
652	}
653	set _downloadPopup(image_controls) $inner.image_frame
654	set num [llength [get]]
655	set num [expr {($num == 1) ? "1 result" : "$num results"}]
656	set word [Rappture::filexfer::label downloadWord]
657	$inner.summary configure -text "$word $num in the following format:"
658	update idletasks ;# Fix initial sizes
659	return $popup
660	}
661	now {
662	set popup .vtkviewerdownload
663	if {[winfo exists .vtkviewerdownload]} {
664	$popup deactivate
665	}
666	switch -- $_downloadPopup(format) {
667	"image" {
668	return [$this GetImage [lindex $args 0]]
669	}
670	"vtk" {
671	return [$this GetVtkData [lindex $args 0]]
672	}
673	}
674	return ""
675	}
676	default {
677	error "bad option \"$option\": should be coming, controls, now"
678	}
679	}
680	}
681
682	# ----------------------------------------------------------------------
683	# USAGE: Connect ?<host:port>,<host:port>...?
684	#
685	# Clients use this method to establish a connection to a new
686	# server, or to reestablish a connection to the previous server.
687	# Any existing connection is automatically closed.
688	# ----------------------------------------------------------------------
689	itcl::body Rappture::VtkViewer::Connect {} {
690	set _hosts [GetServerList "vtkvis"]
691	if { "" == $_hosts } {
692	return 0
693	}
694	set result [VisViewer::Connect $_hosts]
695	if { $result } {
696	set w [winfo width $itk_component(view)]
697	set h [winfo height $itk_component(view)]
698	EventuallyResize $w $h
699	}
700	return $result
701	}
702
703	#
704	# isconnected --
705	#
706	# Indicates if we are currently connected to the visualization server.
707	#
708	itcl::body Rappture::VtkViewer::isconnected {} {
709	return [VisViewer::IsConnected]
710	}
711
712	#
713	# disconnect --
714	#
715	itcl::body Rappture::VtkViewer::disconnect {} {
716	Disconnect
717	set _reset 1
718	}
719
720	#
721	# Disconnect --
722	#
723	# Clients use this method to disconnect from the current rendering
724	# server.
725	#
726	itcl::body Rappture::VtkViewer::Disconnect {} {
727	VisViewer::Disconnect
728
729	# disconnected -- no more data sitting on server
730	set _outbuf ""
731	array unset _datasets
732	array unset _data
733	array unset _colormaps
734	}
735
736	#
737	# sendto --
738	#
739	itcl::body Rappture::VtkViewer::sendto { bytes } {
740	SendBytes "$bytes\n"
741	}
742
743	#
744	# SendCmd
745	#
746	# Send commands off to the rendering server. If we're currently
747	# sending data objects to the server, buffer the commands to be
748	# sent later.
749	#
750	itcl::body Rappture::VtkViewer::SendCmd {string} {
751	if { $_buffering } {
752	append _outbuf $string "\n"
753	} else {
754	SendBytes "$string\n"
755	}
756	}
757
758	# ----------------------------------------------------------------------
759	# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
760	#
761	# Invoked automatically whenever the "image" command comes in from
762	# the rendering server. Indicates that binary image data with the
763	# specified <size> will follow.
764	# ----------------------------------------------------------------------
765	itcl::body Rappture::VtkViewer::ReceiveImage { args } {
766	array set info {
767	-token "???"
768	-bytes 0
769	-type image
770	}
771	array set info $args
772	set bytes [ReceiveBytes $info(-bytes)]
773	if { $info(-type) == "image" } {
774	if 0 {
775	set f [open "last.ppm" "w"]
776	puts $f $bytes
777	close $f
778	}
779	$_image(plot) configure -data $bytes
780	set time [clock seconds]
781	set date [clock format $time]
782	if { $_start > 0 } {
783	set finish [clock clicks -milliseconds]
784	set _start 0
785	}
786	} elseif { $info(type) == "print" } {
787	set tag $this-print-$info(-token)
788	set _hardcopy($tag) $bytes
789	}
790	}
791
792	#
793	# ReceiveDataset --
794	#
795	itcl::body Rappture::VtkViewer::ReceiveDataset { args } {
796	if { ![isconnected] } {
797	return
798	}
799	set option [lindex $args 0]
800	switch -- $option {
801	"scalar" {
802	set option [lindex $args 1]
803	switch -- $option {
804	"world" {
805	foreach { x y z value tag } [lrange $args 2 end] break
806	}
807	"pixel" {
808	foreach { x y value tag } [lrange $args 2 end] break
809	}
810	}
811	}
812	"vector" {
813	set option [lindex $args 1]
814	switch -- $option {
815	"world" {
816	foreach { x y z vx vy vz tag } [lrange $args 2 end] break
817	}
818	"pixel" {
819	foreach { x y vx vy vz tag } [lrange $args 2 end] break
820	}
821	}
822	}
823	"names" {
824	foreach { name } [lindex $args 1] {
825	#puts stderr "Dataset: $name"
826	}
827	}
828	default {
829	error "unknown dataset option \"$option\" from server"
830	}
831	}
832	}
833
834	# ----------------------------------------------------------------------
835	# USAGE: Rebuild
836	#
837	# Called automatically whenever something changes that affects the
838	# data in the widget. Clears any existing data and rebuilds the
839	# widget to display new data.
840	# ----------------------------------------------------------------------
841	itcl::body Rappture::VtkViewer::Rebuild {} {
842
843	set w [winfo width $itk_component(view)]
844	set h [winfo height $itk_component(view)]
845	if { $w < 2 \|\| $h < 2 } {
846	$_dispatcher event -idle !rebuild
847	return
848	}
849
850	# Turn on buffering of commands to the server. We don't want to
851	# be preempted by a server disconnect/reconnect (which automatically
852	# generates a new call to Rebuild).
853	set _buffering 1
854
855	set _width $w
856	set _height $h
857	$_arcball resize $w $h
858	DoResize
859	#
860	# Reset the camera and other view parameters
861	#
862	set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
863	$_arcball quaternion $q
864	if {$_view(ortho)} {
865	SendCmd "camera mode ortho"
866	} else {
867	SendCmd "camera mode persp"
868	}
869	DoRotate
870	PanCamera
871	set _first [lindex [get -objects] 0]
872	if { $_reset \|\| $_first == "" } {
873	Zoom reset
874	set _reset 0
875	}
876	FixSettings axis-xgrid axis-ygrid axis-zgrid axis-mode \
877	axis-visible axis-labels \
878	volume-edges volume-lighting volume-opacity volume-visible \
879	volume-wireframe
880
881	#SendCmd "imgflush"
882
883	set _limits(zmin) ""
884	set _limits(zmax) ""
885	set _first ""
886	foreach dataobj [get -objects] {
887	if { [info exists _obj2ovride($dataobj-raise)] && $_first == "" } {
888	set _first $dataobj
889	}
890	set _obj2datasets($dataobj) ""
891	foreach comp [$dataobj components] {
892	set tag $dataobj-$comp
893	if { ![info exists _datasets($tag)] } {
894	set bytes [$dataobj data $comp]
895	set length [string length $bytes]
896	append _outbuf "dataset add $tag data follows $length\n"
897	append _outbuf $bytes
898	if { [$dataobj type $comp] != "glyphs" } {
899	}
900	set _datasets($tag) 1
901	}
902	lappend _obj2datasets($dataobj) $tag
903	if { [info exists _obj2ovride($dataobj-raise)] } {
904	SendCmd "dataset visible 1 $tag"
905	} else {
906	SendCmd "dataset visible 0 $tag"
907	}
908	SetObjectStyle $dataobj $comp
909	}
910	}
911	if {"" != $_first} {
912	set location [$_first hints camera]
913	if { $location != "" } {
914	array set view $location
915	}
916
917	foreach axis { x y z } {
918	set label [$_first hints ${axis}label]
919	if { $label != "" } {
920	SendCmd "axis name $axis $label"
921	}
922	set units [$_first hints ${axis}units]
923	if { $units != "" } {
924	SendCmd "axis units $axis $units"
925	}
926	}
927	}
928	SendCmd "dataset maprange visible"
929
930	set _buffering 0; # Turn off buffering.
931
932	# Actually write the commands to the server socket. If it fails, we don't
933	# care. We're finished here.
934	blt::busy hold $itk_component(hull)
935	SendBytes $_outbuf;
936	blt::busy release $itk_component(hull)
937	set _outbuf ""; # Clear the buffer.
938	}
939
940	# ----------------------------------------------------------------------
941	# USAGE: CurrentDatasets ?-all -visible? ?dataobjs?
942	#
943	# Returns a list of server IDs for the current datasets being displayed. This
944	# is normally a single ID, but it might be a list of IDs if the current data
945	# object has multiple components.
946	# ----------------------------------------------------------------------
947	itcl::body Rappture::VtkViewer::CurrentDatasets {args} {
948	set flag [lindex $args 0]
949	switch -- $flag {
950	"-all" {
951	if { [llength $args] > 1 } {
952	error "CurrentDatasets: can't specify dataobj after \"-all\""
953	}
954	set dlist [get -objects]
955	}
956	"-visible" {
957	if { [llength $args] > 1 } {
958	set dlist {}
959	set args [lrange $args 1 end]
960	foreach dataobj $args {
961	if { [info exists _obj2ovride($dataobj-raise)] } {
962	lappend dlist $dataobj
963	}
964	}
965	} else {
966	set dlist [get -visible]
967	}
968	}
969	default {
970	set dlist $args
971	}
972	}
973	set rlist ""
974	foreach dataobj $dlist {
975	foreach comp [$dataobj components] {
976	set tag $dataobj-$comp
977	if { [info exists _datasets($tag)] && $_datasets($tag) } {
978	lappend rlist $tag
979	}
980	}
981	}
982	return $rlist
983	}
984
985	# ----------------------------------------------------------------------
986	# USAGE: Zoom in
987	# USAGE: Zoom out
988	# USAGE: Zoom reset
989	#
990	# Called automatically when the user clicks on one of the zoom
991	# controls for this widget. Changes the zoom for the current view.
992	# ----------------------------------------------------------------------
993	itcl::body Rappture::VtkViewer::Zoom {option} {
994	switch -- $option {
995	"in" {
996	set _view(zoom) [expr {$_view(zoom)*1.25}]
997	SendCmd "camera zoom $_view(zoom)"
998	}
999	"out" {
1000	set _view(zoom) [expr {$_view(zoom)*0.8}]
1001	SendCmd "camera zoom $_view(zoom)"
1002	}
1003	"reset" {
1004	array set _view {
1005	qw 1
1006	qx 0
1007	qy 0
1008	qz 0
1009	zoom 1.0
1010	xpan 0
1011	ypan 0
1012	}
1013	SendCmd "camera reset all"
1014	if { $_first != "" } {
1015	set location [$_first hints camera]
1016	if { $location != "" } {
1017	array set _view $location
1018	}
1019	}
1020	set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1021	$_arcball quaternion $q
1022	DoRotate
1023	}
1024	}
1025	}
1026
1027	itcl::body Rappture::VtkViewer::PanCamera {} {
1028	set x $_view(xpan)
1029	set y $_view(ypan)
1030	SendCmd "camera pan $x $y"
1031	}
1032
1033
1034	# ----------------------------------------------------------------------
1035	# USAGE: Rotate click <x> <y>
1036	# USAGE: Rotate drag <x> <y>
1037	# USAGE: Rotate release <x> <y>
1038	#
1039	# Called automatically when the user clicks/drags/releases in the
1040	# plot area. Moves the plot according to the user's actions.
1041	# ----------------------------------------------------------------------
1042	itcl::body Rappture::VtkViewer::Rotate {option x y} {
1043	switch -- $option {
1044	"click" {
1045	$itk_component(view) configure -cursor fleur
1046	set _click(x) $x
1047	set _click(y) $y
1048	}
1049	"drag" {
1050	if {[array size _click] == 0} {
1051	Rotate click $x $y
1052	} else {
1053	set w [winfo width $itk_component(view)]
1054	set h [winfo height $itk_component(view)]
1055	if {$w <= 0 \|\| $h <= 0} {
1056	return
1057	}
1058
1059	if {[catch {
1060	# this fails sometimes for no apparent reason
1061	set dx [expr {double($x-$_click(x))/$w}]
1062	set dy [expr {double($y-$_click(y))/$h}]
1063	}]} {
1064	return
1065	}
1066	if { $dx == 0 && $dy == 0 } {
1067	return
1068	}
1069	set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1070	EventuallyRotate $q
1071	set _click(x) $x
1072	set _click(y) $y
1073	}
1074	}
1075	"release" {
1076	Rotate drag $x $y
1077	$itk_component(view) configure -cursor ""
1078	catch {unset _click}
1079	}
1080	default {
1081	error "bad option \"$option\": should be click, drag, release"
1082	}
1083	}
1084	}
1085
1086	itcl::body Rappture::VtkViewer::Pick {x y} {
1087	foreach tag [CurrentDatasets -visible] {
1088	SendCmd "dataset getscalar pixel $x $y $tag"
1089	}
1090	}
1091
1092	# ----------------------------------------------------------------------
1093	# USAGE: $this Pan click x y
1094	# $this Pan drag x y
1095	# $this Pan release x y
1096	#
1097	# Called automatically when the user clicks on one of the zoom
1098	# controls for this widget. Changes the zoom for the current view.
1099	# ----------------------------------------------------------------------
1100	itcl::body Rappture::VtkViewer::Pan {option x y} {
1101	switch -- $option {
1102	"set" {
1103	set w [winfo width $itk_component(view)]
1104	set h [winfo height $itk_component(view)]
1105	set x [expr $x / double($w)]
1106	set y [expr $y / double($h)]
1107	set _view(xpan) [expr $_view(xpan) + $x]
1108	set _view(ypan) [expr $_view(ypan) + $y]
1109	PanCamera
1110	return
1111	}
1112	"click" {
1113	set _click(x) $x
1114	set _click(y) $y
1115	$itk_component(view) configure -cursor hand1
1116	}
1117	"drag" {
1118	if { ![info exists _click(x)] } {
1119	set _click(x) $x
1120	}
1121	if { ![info exists _click(y)] } {
1122	set _click(y) $y
1123	}
1124	set w [winfo width $itk_component(view)]
1125	set h [winfo height $itk_component(view)]
1126	set dx [expr ($_click(x) - $x)/double($w)]
1127	set dy [expr ($_click(y) - $y)/double($h)]
1128	set _click(x) $x
1129	set _click(y) $y
1130	set _view(xpan) [expr $_view(xpan) - $dx]
1131	set _view(ypan) [expr $_view(ypan) - $dy]
1132	PanCamera
1133	}
1134	"release" {
1135	Pan drag $x $y
1136	$itk_component(view) configure -cursor ""
1137	}
1138	default {
1139	error "unknown option \"$option\": should set, click, drag, or release"
1140	}
1141	}
1142	}
1143
1144	# ----------------------------------------------------------------------
1145	# USAGE: FixSettings <what> ?<value>?
1146	#
1147	# Used internally to update rendering settings whenever parameters
1148	# change in the popup settings panel. Sends the new settings off
1149	# to the back end.
1150	# ----------------------------------------------------------------------
1151	itcl::body Rappture::VtkViewer::FixSettings { args } {
1152	foreach setting $args {
1153	AdjustSetting $setting
1154	}
1155	}
1156
1157	#
1158	# AdjustSetting --
1159	#
1160	# Changes/updates a specific setting in the widget. There are
1161	# usually user-setable option. Commands are sent to the render
1162	# server.
1163	#
1164	itcl::body Rappture::VtkViewer::AdjustSetting {what {value ""}} {
1165	if { ![isconnected] } {
1166	return
1167	}
1168	switch -- $what {
1169	"volume-opacity" {
1170	set val $_volume(opacity)
1171	set sval [expr { 0.01 * double($val) }]
1172	foreach dataset [CurrentDatasets -visible $_first] {
1173	SendCmd "polydata opacity $sval $dataset"
1174	if { $_haveGlyphs } {
1175	SendCmd "glyphs opacity $sval $dataset"
1176	}
1177	}
1178	}
1179	"volume-wireframe" {
1180	set bool $_volume(wireframe)
1181	foreach dataset [CurrentDatasets -visible $_first] {
1182	SendCmd "polydata wireframe $bool $dataset"
1183	if { $_haveGlyphs } {
1184	SendCmd "glyphs wireframe $bool $dataset"
1185	}
1186	}
1187	}
1188	"volume-visible" {
1189	set bool $_volume(visible)
1190	foreach dataset [CurrentDatasets -visible $_first] {
1191	if { $_haveGlyphs } {
1192	SendCmd "glyphs visible $bool $dataset"
1193	}
1194	SendCmd "polydata visible $bool $dataset"
1195	}
1196	}
1197	"volume-lighting" {
1198	set bool $_volume(lighting)
1199	foreach dataset [CurrentDatasets -visible $_first] {
1200	if { $_haveGlyphs } {
1201	SendCmd "glyphs lighting $bool $dataset"
1202	}
1203	SendCmd "polydata lighting $bool $dataset"
1204	}
1205	}
1206	"volume-edges" {
1207	set bool $_volume(edges)
1208	foreach dataset [CurrentDatasets -visible $_first] {
1209	if { $_haveGlyphs } {
1210	SendCmd "glyphs edges $bool $dataset"
1211	}
1212	SendCmd "polydata edges $bool $dataset"
1213	}
1214	}
1215	"axis-visible" {
1216	set bool $_axis(visible)
1217	SendCmd "axis visible all $bool"
1218	}
1219	"axis-labels" {
1220	set bool $_axis(labels)
1221	SendCmd "axis labels all $bool"
1222	}
1223	"axis-xgrid" {
1224	set bool $_axis(xgrid)
1225	SendCmd "axis grid x $bool"
1226	}
1227	"axis-ygrid" {
1228	set bool $_axis(ygrid)
1229	SendCmd "axis grid y $bool"
1230	}
1231	"axis-zgrid" {
1232	set bool $_axis(zgrid)
1233	SendCmd "axis grid z $bool"
1234	}
1235	"axis-mode" {
1236	set mode [$itk_component(axismode) value]
1237	set mode [$itk_component(axismode) translate $mode]
1238	SendCmd "axis flymode $mode"
1239	}
1240	"axis-xcutaway" - "axis-ycutaway" - "axis-zcutaway" {
1241	set axis [string range $what 5 5]
1242	set bool $_axis(${axis}cutaway)
1243	if { $bool } {
1244	set pos [expr $_axis(${axis}position) * 0.01]
1245	set dir $_axis(${axis}direction)
1246	$itk_component(${axis}CutScale) configure -state normal \
1247	-troughcolor white
1248	SendCmd "renderer clipplane $axis $pos $dir"
1249	} else {
1250	$itk_component(${axis}CutScale) configure -state disabled \
1251	-troughcolor grey82
1252	SendCmd "renderer clipplane $axis 1 -1"
1253	}
1254	}
1255	"axis-xposition" - "axis-yposition" - "axis-zposition" -
1256	"axis-xdirection" - "axis-ydirection" - "axis-zdirection" {
1257	set axis [string range $what 5 5]
1258	#set dir $_axis(${axis}direction)
1259	set pos [expr $_axis(${axis}position) * 0.01]
1260	SendCmd "renderer clipplane ${axis} $pos -1"
1261	}
1262	default {
1263	error "don't know how to fix $what"
1264	}
1265	}
1266	}
1267
1268	#
1269	# RequestLegend --
1270	#
1271	# Request a new legend from the server. The size of the legend
1272	# is determined from the height of the canvas. It will be rotated
1273	# to be vertical when drawn.
1274	#
1275	itcl::body Rappture::VtkViewer::RequestLegend {} {
1276	set font "Arial 8"
1277	set lineht [font metrics $font -linespace]
1278	set c $itk_component(legend)
1279	set w 12
1280	set h [expr {$_height - 2 * ($lineht + 2)}]
1281	if { $h < 1} {
1282	return
1283	}
1284	# Set the legend on the first dataset.
1285	foreach dataset [CurrentDatasets -visible] {
1286	foreach {dataobj comp} [split $dataset -] break
1287	if { [info exists _dataset2style($dataset)] } {
1288	SendCmd "legend $_dataset2style($dataset) vmag {} {} $w $h 0"
1289	break;
1290	}
1291	}
1292	}
1293
1294	#
1295	# SetColormap --
1296	#
1297	itcl::body Rappture::VtkViewer::SetColormap { dataobj comp } {
1298	array set style {
1299	-color rainbow
1300	-levels 6
1301	-opacity 1.0
1302	}
1303	set tag $dataobj-$comp
1304	array set style [$dataobj style $comp]
1305	set colormap "$style(-color):$style(-levels):$style(-opacity)"
1306	if { [info exists _colormaps($colormap)] } {
1307	return $colormap
1308	}
1309	if { ![info exists _dataset2style($tag)] } {
1310	set _dataset2style($tag) $colormap
1311	lappend _style2datasets($colormap) $tag
1312	}
1313	if { ![info exists _colormaps($colormap)] } {
1314	# Build the pseudo colormap if it doesn't exist.
1315	BuildColormap $colormap $dataobj $comp
1316	set _colormaps($colormap) 1
1317	}
1318	switch -- [$dataobj type $comp] {
1319	"polygon" {
1320	SendCmd "pseudocolor colormap $colormap $tag"
1321	}
1322	"glyphs" {
1323	#SendCmd "glyphs colormap $colormap $tag"
1324	}
1325	}
1326	return $colormap
1327	}
1328
1329	#
1330	# BuildColormap --
1331	#
1332	itcl::body Rappture::VtkViewer::BuildColormap { colormap dataobj comp } {
1333	array set style {
1334	-color rainbow
1335	-levels 6
1336	-opacity 1.0
1337	}
1338	array set style [$dataobj style $comp]
1339	if {$style(-color) == "rainbow"} {
1340	set style(-color) "white:yellow:green:cyan:blue:magenta"
1341	}
1342	set clist [split $style(-color) :]
1343	set cmap {}
1344	set numColors [llength $clist]
1345	for {set i 0} {$i < $numColors} {incr i} {
1346	set x 0
1347	if { $numColors > 1 } {
1348	set x [expr {double($i)/($numColors-1)}]
1349	}
1350	set color [lindex $clist $i]
1351	append cmap "$x [Color2RGB $color] "
1352	}
1353	if { [llength $cmap] == 0 } {
1354	set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0"
1355	}
1356	if { ![info exists _volume(opacity)] } {
1357	set _volume(opacity) $style(-opacity)
1358	}
1359	set max $_volume(opacity)
1360
1361	set wmap "0.0 1.0 1.0 1.0"
1362	SendCmd "colormap add $colormap { $cmap } { $wmap }"
1363	}
1364
1365	# ----------------------------------------------------------------------
1366	# CONFIGURATION OPTION: -plotbackground
1367	# ----------------------------------------------------------------------
1368	itcl::configbody Rappture::VtkViewer::plotbackground {
1369	if { [isconnected] } {
1370	foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1371	SendCmd "screen bgcolor $r $g $b"
1372	}
1373	}
1374
1375	# ----------------------------------------------------------------------
1376	# CONFIGURATION OPTION: -plotforeground
1377	# ----------------------------------------------------------------------
1378	itcl::configbody Rappture::VtkViewer::plotforeground {
1379	if { [isconnected] } {
1380	foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1381	#fix this!
1382	#SendCmd "color background $r $g $b"
1383	}
1384	}
1385
1386	itcl::body Rappture::VtkViewer::limits { dataobj } {
1387
1388	array unset _limits $dataobj-*
1389	foreach comp [$dataobj components] {
1390	set tag $dataobj-$comp
1391	if { ![info exists _limits($tag)] } {
1392	set data [$dataobj data $comp]
1393	set tmpfile file[pid].vtk
1394	set f [open "$tmpfile" "w"]
1395	fconfigure $f -translation binary -encoding binary
1396	puts $f $data
1397	close $f
1398	set reader [vtkDataSetReader $tag-xvtkDataSetReader]
1399	$reader SetFileName $tmpfile
1400	$reader ReadAllNormalsOn
1401	$reader ReadAllScalarsOn
1402	$reader ReadAllVectorsOn
1403	$reader ReadAllFieldsOn
1404	$reader Update
1405	set output [$reader GetOutput]
1406	set _limits($tag) [$output GetBounds]
1407	set pointData [$output GetPointData]
1408	set fieldData [$output GetFieldData]
1409	if 0 {
1410	puts stderr "\#scalars=[$reader GetNumberOfScalarsInFile]"
1411	puts stderr "\#vectors=[$reader GetNumberOfVectorsInFile]"
1412	puts stderr "\#tensors=[$reader GetNumberOfTensorsInFile]"
1413	puts stderr "\#normals=[$reader GetNumberOfNormalsInFile]"
1414	puts stderr "\#fielddata=[$reader GetNumberOfFieldDataInFile]"
1415	puts stderr "fielddataname=[$reader GetFieldDataNameInFile 0]"
1416	puts stderr "field \#arrays=[$fieldData GetNumberOfArrays]"
1417	puts stderr "point \#arrays=[$pointData GetNumberOfArrays]"
1418	puts stderr "field \#components=[$fieldData GetNumberOfComponents]"
1419	puts stderr "point \#components=[$pointData GetNumberOfComponents]"
1420	puts stderr "field \#tuples=[$fieldData GetNumberOfTuples]"
1421	puts stderr "point \#tuples=[$pointData GetNumberOfTuples]"
1422	puts stderr "point \#scalars=[$pointData GetScalars]"
1423	puts stderr vectors=[$pointData GetVectors]
1424	}
1425	rename $output ""
1426	rename $reader ""
1427	file delete $tmpfile
1428	}
1429	foreach { xMin xMax yMin yMax zMin zMax} $_limits($tag) break
1430	if {![info exists limits(xmin)] \|\| $limits(xmin) > $xMin} {
1431	set limits(xmin) $xMin
1432	}
1433	if {![info exists limits(xmax)] \|\| $limits(xmax) < $xMax} {
1434	set limits(xmax) $xMax
1435	}
1436	if {![info exists limits(ymin)] \|\| $limits(ymin) > $yMin} {
1437	set limits(ymin) $xMin
1438	}
1439	if {![info exists limits(ymax)] \|\| $limits(ymax) < $yMax} {
1440	set limits(ymax) $yMax
1441	}
1442	if {![info exists limits(zmin)] \|\| $limits(zmin) > $zMin} {
1443	set limits(zmin) $zMin
1444	}
1445	if {![info exists limits(zmax)] \|\| $limits(zmax) < $zMax} {
1446	set limits(zmax) $zMax
1447	}
1448	}
1449	return [array get limits]
1450	}
1451
1452	itcl::body Rappture::VtkViewer::BuildVolumeTab {} {
1453
1454	set fg [option get $itk_component(hull) font Font]
1455	#set bfg [option get $itk_component(hull) boldFont Font]
1456
1457	set inner [$itk_component(main) insert end \
1458	-title "Volume Settings" \
1459	-icon [Rappture::icon volume-on]]
1460	$inner configure -borderwidth 4
1461
1462	checkbutton $inner.volume \
1463	-text "Show Volume" \
1464	-variable [itcl::scope _volume(visible)] \
1465	-command [itcl::code $this AdjustSetting volume-visible] \
1466	-font "Arial 9"
1467
1468	checkbutton $inner.wireframe \
1469	-text "Show Wireframe" \
1470	-variable [itcl::scope _volume(wireframe)] \
1471	-command [itcl::code $this AdjustSetting volume-wireframe] \
1472	-font "Arial 9"
1473
1474	checkbutton $inner.lighting \
1475	-text "Enable Lighting" \
1476	-variable [itcl::scope _volume(lighting)] \
1477	-command [itcl::code $this AdjustSetting volume-lighting] \
1478	-font "Arial 9"
1479
1480	checkbutton $inner.edges \
1481	-text "Show Edges" \
1482	-variable [itcl::scope _volume(edges)] \
1483	-command [itcl::code $this AdjustSetting volume-edges] \
1484	-font "Arial 9"
1485
1486	label $inner.opacity_l -text "Opacity" -font "Arial 9"
1487	::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1488	-variable [itcl::scope _volume(opacity)] \
1489	-width 10 \
1490	-showvalue off \
1491	-command [itcl::code $this AdjustSetting volume-opacity]
1492
1493	blt::table $inner \
1494	0,0 $inner.volume -anchor w -pady 2 \
1495	1,0 $inner.wireframe -anchor w -pady 2 \
1496	2,0 $inner.lighting -anchor w -pady 2 \
1497	3,0 $inner.edges -anchor w -pady 2 \
1498	4,0 $inner.opacity_l -anchor w -pady 2 \
1499	5,0 $inner.opacity -fill x -pady 2
1500
1501	blt::table configure $inner r* c* -resize none
1502	blt::table configure $inner r6 c1 -resize expand
1503	}
1504
1505	itcl::body Rappture::VtkViewer::BuildAxisTab {} {
1506
1507	set fg [option get $itk_component(hull) font Font]
1508	#set bfg [option get $itk_component(hull) boldFont Font]
1509
1510	set inner [$itk_component(main) insert end \
1511	-title "Axis Settings" \
1512	-icon [Rappture::icon axis1]]
1513	$inner configure -borderwidth 4
1514
1515	checkbutton $inner.visible \
1516	-text "Show Axes" \
1517	-variable [itcl::scope _axis(visible)] \
1518	-command [itcl::code $this AdjustSetting axis-visible] \
1519	-font "Arial 9"
1520
1521	checkbutton $inner.labels \
1522	-text "Show Axis Labels" \
1523	-variable [itcl::scope _axis(labels)] \
1524	-command [itcl::code $this AdjustSetting axis-labels] \
1525	-font "Arial 9"
1526
1527	checkbutton $inner.gridx \
1528	-text "Show X Grid" \
1529	-variable [itcl::scope _axis(xgrid)] \
1530	-command [itcl::code $this AdjustSetting axis-xgrid] \
1531	-font "Arial 9"
1532	checkbutton $inner.gridy \
1533	-text "Show Y Grid" \
1534	-variable [itcl::scope _axis(ygrid)] \
1535	-command [itcl::code $this AdjustSetting axis-ygrid] \
1536	-font "Arial 9"
1537	checkbutton $inner.gridz \
1538	-text "Show Z Grid" \
1539	-variable [itcl::scope _axis(zgrid)] \
1540	-command [itcl::code $this AdjustSetting axis-zgrid] \
1541	-font "Arial 9"
1542
1543	label $inner.mode_l -text "Mode" -font "Arial 9"
1544
1545	itk_component add axismode {
1546	Rappture::Combobox $inner.mode -width 10 -editable no
1547	}
1548	$inner.mode choices insert end \
1549	"static_triad" "static" \
1550	"closest_triad" "closest" \
1551	"furthest_triad" "furthest" \
1552	"outer_edges" "outer"
1553	$itk_component(axismode) value "static"
1554	bind $inner.mode <<Value>> [itcl::code $this AdjustSetting axis-mode]
1555
1556	blt::table $inner \
1557	0,0 $inner.visible -anchor w -cspan 2 \
1558	1,0 $inner.labels -anchor w -cspan 2 \
1559	2,0 $inner.gridx -anchor w -cspan 2 \
1560	3,0 $inner.gridy -anchor w -cspan 2 \
1561	4,0 $inner.gridz -anchor w -cspan 2 \
1562	5,0 $inner.mode_l -anchor w -cspan 2 -padx { 2 0 } \
1563	6,0 $inner.mode -fill x -cspan 2
1564
1565	blt::table configure $inner r* c* -resize none
1566	blt::table configure $inner r7 c1 -resize expand
1567	}
1568
1569
1570	itcl::body Rappture::VtkViewer::BuildCameraTab {} {
1571	set inner [$itk_component(main) insert end \
1572	-title "Camera Settings" \
1573	-icon [Rappture::icon camera]]
1574	$inner configure -borderwidth 4
1575
1576	set labels { qx qy qz qw xpan ypan zoom }
1577	set row 0
1578	foreach tag $labels {
1579	label $inner.${tag}label -text $tag -font "Arial 9"
1580	entry $inner.${tag} -font "Arial 9" -bg white \
1581	-textvariable [itcl::scope _view($tag)]
1582	bind $inner.${tag} <KeyPress-Return> \
1583	[itcl::code $this camera set ${tag}]
1584	blt::table $inner \
1585	$row,0 $inner.${tag}label -anchor e -pady 2 \
1586	$row,1 $inner.${tag} -anchor w -pady 2
1587	blt::table configure $inner r$row -resize none
1588	incr row
1589	}
1590	checkbutton $inner.ortho \
1591	-text "Orthographic Projection" \
1592	-variable [itcl::scope _view(ortho)] \
1593	-command [itcl::code $this camera set ortho] \
1594	-font "Arial 9"
1595	blt::table $inner \
1596	$row,0 $inner.ortho -columnspan 2 -anchor w -pady 2
1597	blt::table configure $inner r$row -resize none
1598	incr row
1599
1600	blt::table configure $inner c0 c1 -resize none
1601	blt::table configure $inner c2 -resize expand
1602	blt::table configure $inner r$row -resize expand
1603	}
1604
1605	itcl::body Rappture::VtkViewer::BuildCutawayTab {} {
1606
1607	set fg [option get $itk_component(hull) font Font]
1608
1609	set inner [$itk_component(main) insert end \
1610	-title "Cutaway Along Axis" \
1611	-icon [Rappture::icon cutbutton]]
1612
1613	$inner configure -borderwidth 4
1614
1615	# X-value slicer...
1616	itk_component add xCutButton {
1617	Rappture::PushButton $inner.xbutton \
1618	-onimage [Rappture::icon x-cutplane] \
1619	-offimage [Rappture::icon x-cutplane] \
1620	-command [itcl::code $this AdjustSetting axis-xcutaway] \
1621	-variable [itcl::scope _axis(xcutaway)]
1622	}
1623	Rappture::Tooltip::for $itk_component(xCutButton) \
1624	"Toggle the X-axis cutaway on/off"
1625
1626	itk_component add xCutScale {
1627	::scale $inner.xval -from 100 -to 1 \
1628	-width 10 -orient vertical -showvalue yes \
1629	-borderwidth 1 -highlightthickness 0 \
1630	-command [itcl::code $this Slice move x] \
1631	-variable [itcl::scope _axis(xposition)]
1632	} {
1633	usual
1634	ignore -borderwidth -highlightthickness
1635	}
1636	# Set the default cutaway value before disabling the scale.
1637	$itk_component(xCutScale) set 100
1638	$itk_component(xCutScale) configure -state disabled
1639	Rappture::Tooltip::for $itk_component(xCutScale) \
1640	"@[itcl::code $this Slice tooltip x]"
1641
1642	itk_component add xDirButton {
1643	Rappture::PushButton $inner.xdir \
1644	-onimage [Rappture::icon arrow-down] \
1645	-onvalue -1 \
1646	-offimage [Rappture::icon arrow-up] \
1647	-offvalue 1 \
1648	-command [itcl::code $this AdjustSetting axis-xdirection] \
1649	-variable [itcl::scope _axis(xdirection)]
1650	}
1651	set _axis(xdirection) -1
1652	Rappture::Tooltip::for $itk_component(xDirButton) \
1653	"Toggle the direction of the X-axis cutaway"
1654
1655	# Y-value slicer...
1656	itk_component add yCutButton {
1657	Rappture::PushButton $inner.ybutton \
1658	-onimage [Rappture::icon y-cutplane] \
1659	-offimage [Rappture::icon y-cutplane] \
1660	-command [itcl::code $this AdjustSetting axis-ycutaway] \
1661	-variable [itcl::scope _axis(ycutaway)]
1662	}
1663	Rappture::Tooltip::for $itk_component(yCutButton) \
1664	"Toggle the Y-axis cutaway on/off"
1665
1666	itk_component add yCutScale {
1667	::scale $inner.yval -from 100 -to 1 \
1668	-width 10 -orient vertical -showvalue yes \
1669	-borderwidth 1 -highlightthickness 0 \
1670	-command [itcl::code $this Slice move y] \
1671	-variable [itcl::scope _axis(yposition)]
1672	} {
1673	usual
1674	ignore -borderwidth -highlightthickness
1675	}
1676	Rappture::Tooltip::for $itk_component(yCutScale) \
1677	"@[itcl::code $this Slice tooltip y]"
1678	# Set the default cutaway value before disabling the scale.
1679	$itk_component(yCutScale) set 100
1680	$itk_component(yCutScale) configure -state disabled
1681
1682	itk_component add yDirButton {
1683	Rappture::PushButton $inner.ydir \
1684	-onimage [Rappture::icon arrow-down] \
1685	-onvalue -1 \
1686	-offimage [Rappture::icon arrow-up] \
1687	-offvalue 1 \
1688	-command [itcl::code $this AdjustSetting axis-ydirection] \
1689	-variable [itcl::scope _axis(ydirection)]
1690	}
1691	Rappture::Tooltip::for $itk_component(yDirButton) \
1692	"Toggle the direction of the Y-axis cutaway"
1693	set _axis(ydirection) -1
1694
1695	# Z-value slicer...
1696	itk_component add zCutButton {
1697	Rappture::PushButton $inner.zbutton \
1698	-onimage [Rappture::icon z-cutplane] \
1699	-offimage [Rappture::icon z-cutplane] \
1700	-command [itcl::code $this AdjustSetting axis-zcutaway] \
1701	-variable [itcl::scope _axis(zcutaway)]
1702	}
1703	Rappture::Tooltip::for $itk_component(zCutButton) \
1704	"Toggle the Z-axis cutaway on/off"
1705
1706	itk_component add zCutScale {
1707	::scale $inner.zval -from 100 -to 1 \
1708	-width 10 -orient vertical -showvalue yes \
1709	-borderwidth 1 -highlightthickness 0 \
1710	-command [itcl::code $this Slice move z] \
1711	-variable [itcl::scope _axis(zposition)]
1712	} {
1713	usual
1714	ignore -borderwidth -highlightthickness
1715	}
1716	$itk_component(zCutScale) set 100
1717	$itk_component(zCutScale) configure -state disabled
1718	#$itk_component(zCutScale) configure -state disabled
1719	Rappture::Tooltip::for $itk_component(zCutScale) \
1720	"@[itcl::code $this Slice tooltip z]"
1721
1722	itk_component add zDirButton {
1723	Rappture::PushButton $inner.zdir \
1724	-onimage [Rappture::icon arrow-down] \
1725	-onvalue -1 \
1726	-offimage [Rappture::icon arrow-up] \
1727	-offvalue 1 \
1728	-command [itcl::code $this AdjustSetting axis-zdirection] \
1729	-variable [itcl::scope _axis(zdirection)]
1730	}
1731	set _axis(zdirection) -1
1732	Rappture::Tooltip::for $itk_component(zDirButton) \
1733	"Toggle the direction of the Z-axis cutaway"
1734
1735	blt::table $inner \
1736	0,0 $itk_component(xCutButton) -anchor e -padx 2 -pady 2 \
1737	1,0 $itk_component(xCutScale) -fill y \
1738	0,1 $itk_component(yCutButton) -anchor e -padx 2 -pady 2 \
1739	1,1 $itk_component(yCutScale) -fill y \
1740	0,2 $itk_component(zCutButton) -anchor e -padx 2 -pady 2 \
1741	1,2 $itk_component(zCutScale) -fill y \
1742
1743	blt::table configure $inner r* c* -resize none
1744	blt::table configure $inner r1 c3 -resize expand
1745	}
1746
1747
1748
1749	#
1750	# camera --
1751	#
1752	itcl::body Rappture::VtkViewer::camera {option args} {
1753	switch -- $option {
1754	"show" {
1755	puts [array get _view]
1756	}
1757	"set" {
1758	set who [lindex $args 0]
1759	set x $_view($who)
1760	set code [catch { string is double $x } result]
1761	if { $code != 0 \|\| !$result } {
1762	return
1763	}
1764	switch -- $who {
1765	"ortho" {
1766	if {$_view(ortho)} {
1767	SendCmd "camera mode ortho"
1768	} else {
1769	SendCmd "camera mode persp"
1770	}
1771	}
1772	"xpan" - "ypan" {
1773	PanCamera
1774	}
1775	"qx" - "qy" - "qz" - "qw" {
1776	set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1777	$_arcball quaternion $q
1778	EventuallyRotate $q
1779	}
1780	"zoom" {
1781	SendCmd "camera zoom $_view(zoom)"
1782	}
1783	}
1784	}
1785	}
1786	}
1787
1788	itcl::body Rappture::VtkViewer::ConvertToVtkData { dataobj comp } {
1789	foreach { x1 x2 xN y1 y2 yN } [$dataobj mesh $comp] break
1790	set values [$dataobj values $comp]
1791	append out "# vtk DataFile Version 2.0 \n"
1792	append out "Test data \n"
1793	append out "ASCII \n"
1794	append out "DATASET STRUCTURED_POINTS \n"
1795	append out "DIMENSIONS $xN $yN 1 \n"
1796	append out "ORIGIN 0 0 0 \n"
1797	append out "SPACING 1 1 1 \n"
1798	append out "POINT_DATA [expr $xN * $yN] \n"
1799	append out "SCALARS field float 1 \n"
1800	append out "LOOKUP_TABLE default \n"
1801	append out [join $values "\n"]
1802	append out "\n"
1803	return $out
1804	}
1805
1806
1807	itcl::body Rappture::VtkViewer::GetVtkData { args } {
1808	set bytes ""
1809	foreach dataobj [get] {
1810	foreach comp [$dataobj components] {
1811	set tag $dataobj-$comp
1812	set contents [ConvertToVtkData $dataobj $comp]
1813	append bytes "$contents\n\n"
1814	}
1815	}
1816	return [list .txt $bytes]
1817	}
1818
1819	itcl::body Rappture::VtkViewer::GetImage { args } {
1820	if { [image width $_image(download)] > 0 &&
1821	[image height $_image(download)] > 0 } {
1822	set bytes [$_image(download) data -format "jpeg -quality 100"]
1823	set bytes [Rappture::encoding::decode -as b64 $bytes]
1824	return [list .jpg $bytes]
1825	}
1826	return ""
1827	}
1828
1829	itcl::body Rappture::VtkViewer::BuildDownloadPopup { popup command } {
1830	Rappture::Balloon $popup \
1831	-title "[Rappture::filexfer::label downloadWord] as..."
1832	set inner [$popup component inner]
1833	label $inner.summary -text "" -anchor w
1834	radiobutton $inner.vtk_button -text "VTK data file" \
1835	-variable [itcl::scope _downloadPopup(format)] \
1836	-font "Helvetica 9 " \
1837	-value vtk
1838	Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
1839	radiobutton $inner.image_button -text "Image File" \
1840	-variable [itcl::scope _downloadPopup(format)] \
1841	-value image
1842	Rappture::Tooltip::for $inner.image_button \
1843	"Save as digital image."
1844
1845	button $inner.ok -text "Save" \
1846	-highlightthickness 0 -pady 2 -padx 3 \
1847	-command $command \
1848	-compound left \
1849	-image [Rappture::icon download]
1850
1851	button $inner.cancel -text "Cancel" \
1852	-highlightthickness 0 -pady 2 -padx 3 \
1853	-command [list $popup deactivate] \
1854	-compound left \
1855	-image [Rappture::icon cancel]
1856
1857	blt::table $inner \
1858	0,0 $inner.summary -cspan 2 \
1859	1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
1860	2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
1861	4,1 $inner.cancel -width .9i -fill y \
1862	4,0 $inner.ok -padx 2 -width .9i -fill y
1863	blt::table configure $inner r3 -height 4
1864	blt::table configure $inner r4 -pady 4
1865	raise $inner.image_button
1866	$inner.vtk_button invoke
1867	return $inner
1868	}
1869
1870	itcl::body Rappture::VtkViewer::SetObjectStyle { dataobj comp } {
1871	# Parse style string.
1872	set tag $dataobj-$comp
1873	set type [$dataobj type $comp]
1874	set style [$dataobj style $comp]
1875	if { $dataobj != $_first } {
1876	set settings(-wireframe) 1
1877	}
1878	if { $type == "glyphs" } {
1879	array set settings {
1880	-color \#808080
1881	-gscale 1
1882	-edges 0
1883	-edgecolor black
1884	-linewidth 1.0
1885	-opacity 1.0
1886	-wireframe 0
1887	-lighting 1
1888	-visible 1
1889	}
1890	set shape [$dataobj shape $comp]
1891	array set settings $style
1892	SendCmd "glyphs add $shape $tag"
1893	SendCmd "glyphs normscale 0 $tag"
1894	SendCmd "glyphs gscale $settings(-gscale) $tag"
1895	SendCmd "glyphs wireframe $settings(-wireframe) $tag"
1896	#SendCmd "glyphs ccolor [Color2RGB $settings(-color)] $tag"
1897	#SendCmd "glyphs colormode ccolor {} $tag"
1898	SendCmd "glyphs smode vcomp {} $tag"
1899	SendCmd "glyphs opacity $settings(-opacity) $tag"
1900	SendCmd "glyphs visible $settings(-visible) $tag"
1901	set _haveGlyphs 1
1902	} else {
1903	array set settings {
1904	-color \#6666FF
1905	-edges 1
1906	-edgecolor black
1907	-linewidth 1.0
1908	-opacity 1.0
1909	-wireframe 0
1910	-lighting 1
1911	-visible 1
1912	}
1913	array set settings $style
1914	SendCmd "polydata add $tag"
1915	SendCmd "polydata visible $settings(-visible) $tag"
1916	set _volume(visible) $settings(-visible)
1917	}
1918	if { $type != "glyphs" } {
1919	SendCmd "polydata edges $settings(-edges) $tag"
1920	set _volume(edges) $settings(-edges)
1921	SendCmd "polydata color [Color2RGB $settings(-color)] $tag"
1922	SendCmd "polydata lighting $settings(-lighting) $tag"
1923	set _volume(lighting) $settings(-lighting)
1924	SendCmd "polydata linecolor [Color2RGB $settings(-edgecolor)] $tag"
1925	SendCmd "polydata linewidth $settings(-linewidth) $tag"
1926	SendCmd "polydata opacity $settings(-opacity) $tag"
1927	set _volume(opacity) $settings(-opacity)
1928	SendCmd "polydata wireframe $settings(-wireframe) $tag"
1929	set _volume(wireframe) $settings(-wireframe)
1930	}
1931	set _volume(opacity) [expr $settings(-opacity) * 100.0]
1932	SetColormap $dataobj $comp
1933	}
1934
1935	itcl::body Rappture::VtkViewer::IsValidObject { dataobj } {
1936	if {[catch {$dataobj isa Rappture::Drawing} valid] != 0 \|\| !$valid} {
1937	return 0
1938	}
1939	return 1
1940	}
1941
1942	# ----------------------------------------------------------------------
1943	# USAGE: ReceiveLegend <colormap> <title> <vmin> <vmax> <size>
1944	#
1945	# Invoked automatically whenever the "legend" command comes in from
1946	# the rendering server. Indicates that binary image data with the
1947	# specified <size> will follow.
1948	# ----------------------------------------------------------------------
1949	itcl::body Rappture::VtkViewer::ReceiveLegend { colormap title vmin vmax size } {
1950	set _limits(vmin) $vmin
1951	set _limits(vmax) $vmax
1952	set _title $title
1953	if { [IsConnected] } {
1954	set bytes [ReceiveBytes $size]
1955	if { ![info exists _image(legend)] } {
1956	set _image(legend) [image create photo]
1957	}
1958	$_image(legend) configure -data $bytes
1959	DrawLegend
1960	}
1961	}
1962
1963	#
1964	# DrawLegend --
1965	#
1966	# Draws the legend in it's own canvas which resides to the right
1967	# of the contour plot area.
1968	#
1969	itcl::body Rappture::VtkViewer::DrawLegend {} {
1970	set c $itk_component(view)
1971	set w [winfo width $c]
1972	set h [winfo height $c]
1973	set font "Arial 8"
1974	set lineht [font metrics $font -linespace]
1975
1976	if { $_settings(legend) } {
1977	set x [expr $w - 2]
1978	if { [$c find withtag "legend"] == "" } {
1979	$c create image $x [expr {$lineht+2}] \
1980	-anchor ne \
1981	-image $_image(legend) -tags "colormap legend"
1982	$c create text $x 2 \
1983	-anchor ne \
1984	-fill $itk_option(-plotforeground) -tags "vmax legend" \
1985	-font $font
1986	$c create text $x [expr {$h-2}] \
1987	-anchor se \
1988	-fill $itk_option(-plotforeground) -tags "vmin legend" \
1989	-font $font
1990	#$c bind colormap <Enter> [itcl::code $this EnterLegend %x %y]
1991	$c bind colormap <Leave> [itcl::code $this LeaveLegend]
1992	$c bind colormap <Motion> [itcl::code $this MotionLegend %x %y]
1993	}
1994	# Reset the item coordinates according the current size of the plot.
1995	$c coords colormap $x [expr {$lineht+2}]
1996	if { $_limits(vmin) != "" } {
1997	$c itemconfigure vmin -text [format %g $_limits(vmin)]
1998	}
1999	if { $_limits(vmax) != "" } {
2000	$c itemconfigure vmax -text [format %g $_limits(vmax)]
2001	}
2002	$c coords vmin $x [expr {$h-2}]
2003	$c coords vmax $x 2
2004	}
2005	}
2006
2007	#
2008	# EnterLegend --
2009	#
2010	itcl::body Rappture::VtkViewer::EnterLegend { x y } {
2011	SetLegendTip $x $y
2012	}
2013
2014	#
2015	# MotionLegend --
2016	#
2017	itcl::body Rappture::VtkViewer::MotionLegend { x y } {
2018	Rappture::Tooltip::tooltip cancel
2019	set c $itk_component(view)
2020	SetLegendTip $x $y
2021	}
2022
2023	#
2024	# LeaveLegend --
2025	#
2026	itcl::body Rappture::VtkViewer::LeaveLegend { } {
2027	Rappture::Tooltip::tooltip cancel
2028	.rappturetooltip configure -icon ""
2029	}
2030
2031	#
2032	# SetLegendTip --
2033	#
2034	itcl::body Rappture::VtkViewer::SetLegendTip { x y } {
2035	set c $itk_component(view)
2036	set w [winfo width $c]
2037	set h [winfo height $c]
2038	set font "Arial 8"
2039	set lineht [font metrics $font -linespace]
2040
2041	set imgHeight [image height $_image(legend)]
2042	set coords [$c coords colormap]
2043	set imgX [expr $w - [image width $_image(legend)] - 2]
2044	set imgY [expr $y - $lineht - 2]
2045
2046	# Make a swatch of the selected color
2047	if { [catch { $_image(legend) get 10 $imgY } pixel] != 0 } {
2048	return
2049	}
2050	if { ![info exists _image(swatch)] } {
2051	set _image(swatch) [image create photo -width 24 -height 24]
2052	}
2053	set color [eval format "\#%02x%02x%02x" $pixel]
2054	$_image(swatch) put black -to 0 0 23 23
2055	$_image(swatch) put $color -to 1 1 22 22
2056	.rappturetooltip configure -icon $_image(swatch)
2057
2058	# Compute the value of the point
2059	set t [expr 1.0 - (double($imgY) / double($imgHeight-1))]
2060	set value [expr $t * ($_limits(vmax) - $_limits(vmin)) + $_limits(vmin)]
2061	set tipx [expr $x + 15]
2062	set tipy [expr $y - 5]
2063	Rappture::Tooltip::text $c "$_title $value"
2064	Rappture::Tooltip::tooltip show $c +$tipx,+$tipy
2065	}
2066
2067
2068	# ----------------------------------------------------------------------
2069	# USAGE: Slice move x\|y\|z <newval>
2070	#
2071	# Called automatically when the user drags the slider to move the
2072	# cut plane that slices 3D data. Gets the current value from the
2073	# slider and moves the cut plane to the appropriate point in the
2074	# data set.
2075	# ----------------------------------------------------------------------
2076	itcl::body Rappture::VtkViewer::Slice {option args} {
2077	switch -- $option {
2078	"move" {
2079	set axis [lindex $args 0]
2080	set oldval $_axis(${axis}position)
2081	set newval [lindex $args 1]
2082	if {[llength $args] != 2} {
2083	error "wrong # args: should be \"Slice move x\|y\|z newval\""
2084	}
2085	set newpos [expr {0.01*$newval}]
2086	SendCmd "renderer clipplane $axis $newpos -1"
2087	}
2088	"tooltip" {
2089	set axis [lindex $args 0]
2090	set val [$itk_component(${axis}CutScale) get]
2091	return "Move the [string toupper $axis] cut plane.\nCurrently: $axis = $val%"
2092	}
2093	default {
2094	error "bad option \"$option\": should be axis, move, or tooltip"
2095	}
2096	}
2097	}

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

Download in other formats: