Context Navigation

source: trunk/gui/scripts/vtksurfaceviewer.tcl @ 5184

Last change on this file since 5184 was 5184, checked in by ldelgass, 10 years ago
s/wmap/amap/
File size: 79.7 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: vtksurfaceviewer - Vtk 3D boundary surface 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-2014 HUBzero Foundation, LLC
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 *VtkSurfaceViewer.width 4i widgetDefault
19	option add VtkSurfaceViewercursor crosshair widgetDefault
20	option add *VtkSurfaceViewer.height 4i widgetDefault
21	option add *VtkSurfaceViewer.foreground black widgetDefault
22	option add *VtkSurfaceViewer.controlBackground gray widgetDefault
23	option add *VtkSurfaceViewer.controlDarkBackground #999999 widgetDefault
24	option add *VtkSurfaceViewer.plotBackground black widgetDefault
25	option add *VtkSurfaceViewer.plotForeground white widgetDefault
26	option add *VtkSurfaceViewer.font \
27	--helvetica-medium-r-normal--12-* widgetDefault
28
29	# must use this name -- plugs into Rappture::resources::load
30	proc VtkSurfaceViewer_init_resources {} {
31	Rappture::resources::register \
32	vtkvis_server Rappture::VtkSurfaceViewer::SetServerList
33	}
34
35	itcl::class Rappture::VtkSurfaceViewer {
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 parameters {title args} {
60	# do nothing
61	}
62	public method scale {args}
63
64	# The following methods are only used by this class.
65	private method AdjustSetting {what {value ""}}
66	private method BuildAxisTab {}
67	private method BuildCameraTab {}
68	private method BuildColormap { name }
69	private method BuildDownloadPopup { widget command }
70	private method BuildSurfaceTab {}
71	private method Combo { option }
72	private method Connect {}
73	private method CurrentDatasets {args}
74	private method Disconnect {}
75	private method DoResize {}
76	private method DoRotate {}
77	private method DrawLegend {}
78	private method EnterLegend { x y }
79	private method EventuallyRequestLegend {}
80	private method EventuallyResize { w h }
81	private method EventuallyRotate { q }
82	private method GetImage { args }
83	private method GetVtkData { args }
84	private method InitSettings { args }
85	private method IsValidObject { dataobj }
86	private method LeaveLegend {}
87	private method MotionLegend { x y }
88	private method Pan {option x y}
89	private method PanCamera {}
90	private method Pick {x y}
91	private method QuaternionToView { q } {
92	foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break
93	}
94	private method Rebuild {}
95	private method ReceiveDataset { args }
96	private method ReceiveImage { args }
97	private method ReceiveLegend { colormap title vmin vmax size }
98	private method RequestLegend {}
99	private method Rotate {option x y}
100	private method SetCurrentColormap { color }
101	private method SetCurrentFieldName { dataobj }
102	private method SetLegendTip { x y }
103	private method SetObjectStyle { dataobj comp }
104	private method SetOrientation { side }
105	private method UpdateContourList {}
106	private method ViewToQuaternion {} {
107	return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)]
108	}
109	private method Zoom {option}
110
111	private variable _arcball ""
112
113	private variable _dlist "" ; # list of data objects
114	private variable _obj2datasets
115	private variable _obj2ovride ; # maps dataobj => style override
116	private variable _datasets ; # contains all the dataobj-component
117	; # datasets in the server
118	private variable _colormaps ; # contains all the colormaps
119	; # in the server.
120	# The name of the current colormap used. The colormap is global to all
121	# heightmaps displayed.
122	private variable _currentColormap ""
123	private variable _currentNumContours -1
124
125	private variable _dataset2style ;# maps dataobj-component to transfunc
126
127	private variable _click ; # info used for rotate operations
128	private variable _limits ; # autoscale min/max for all axes
129	private variable _view ; # view params for 3D view
130	private variable _settings
131	private variable _style; # Array of current component styles.
132	private variable _changed
133	private variable _initialStyle; # Array of initial component styles.
134	private variable _reset 1; # Connection to server has been reset.
135
136	private variable _first "" ; # This is the topmost dataset.
137	private variable _start 0
138	private variable _title ""
139	private variable _isolines
140	private variable _contourList ""
141
142	common _downloadPopup; # download options from popup
143	private common _hardcopy
144	private variable _width 0
145	private variable _height 0
146	private variable _resizePending 0
147	private variable _rotatePending 0
148	private variable _legendPending 0
149	private variable _field ""
150	private variable _colorMode "scalar"; # Mode of colormap (vmag or scalar)
151	private variable _fieldNames {}
152	private variable _fields
153	private variable _curFldName ""
154	private variable _curFldLabel ""
155	}
156
157	itk::usual VtkSurfaceViewer {
158	keep -background -foreground -cursor -font
159	keep -plotbackground -plotforeground
160	}
161
162	# ----------------------------------------------------------------------
163	# CONSTRUCTOR
164	# ----------------------------------------------------------------------
165	itcl::body Rappture::VtkSurfaceViewer::constructor {hostlist args} {
166	package require vtk
167	set _serverType "vtkvis"
168
169	# Rebuild event
170	$_dispatcher register !rebuild
171	$_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
172
173	# Resize event
174	$_dispatcher register !resize
175	$_dispatcher dispatch $this !resize "[itcl::code $this DoResize]; list"
176
177	# Rotate event
178	$_dispatcher register !rotate
179	$_dispatcher dispatch $this !rotate "[itcl::code $this DoRotate]; list"
180
181	# Legend event
182	$_dispatcher register !legend
183	$_dispatcher dispatch $this !legend "[itcl::code $this RequestLegend]; list"
184
185	#
186	# Populate parser with commands handle incoming requests
187	#
188	$_parser alias image [itcl::code $this ReceiveImage]
189	$_parser alias dataset [itcl::code $this ReceiveDataset]
190	$_parser alias legend [itcl::code $this ReceiveLegend]
191
192	# Initialize the view to some default parameters.
193	array set _view {
194	-ortho 0
195	-qw 0.853553
196	-qx -0.353553
197	-qy 0.353553
198	-qz 0.146447
199	-xpan 0
200	-ypan 0
201	-zoom 1.0
202	}
203	set _arcball [blt::arcball create 100 100]
204	$_arcball quaternion [ViewToQuaternion]
205
206	array set _settings {
207	-axesvisible 1
208	-axislabels 1
209	-axisminorticks 1
210	-axismode "static"
211	-background black
212	-colormap BCGYR
213	-colormapvisible 1
214	-field "Default"
215	-isolinecolor white
216	-isolinesvisible 0
217	-legendvisible 1
218	-numcontours 10
219	-outline 0
220	-surfaceedges 0
221	-surfacelighting 1
222	-surfaceopacity 100
223	-surfacevisible 1
224	-surfacewireframe 0
225	-xgrid 0
226	-ygrid 0
227	-zgrid 0
228	}
229	array set _changed {
230	-colormap 0
231	-isolinecolor 0
232	-isolinesvisible 0
233	-numcontours 0
234	-outline 0
235	-surfaceedges 0
236	-surfacelighting 0
237	-surfaceopacity 0
238	-surfacevisible 0
239	-surfacewireframe 0
240	}
241
242	itk_component add view {
243	canvas $itk_component(plotarea).view \
244	-highlightthickness 0 -borderwidth 0
245	} {
246	usual
247	ignore -highlightthickness -borderwidth -background
248	}
249
250	itk_component add fieldmenu {
251	menu $itk_component(plotarea).menu -bg black -fg white -relief flat \
252	-tearoff 0
253	} {
254	usual
255	ignore -background -foreground -relief -tearoff
256	}
257	set c $itk_component(view)
258	bind $c <Configure> [itcl::code $this EventuallyResize %w %h]
259	bind $c <4> [itcl::code $this Zoom in 0.25]
260	bind $c <5> [itcl::code $this Zoom out 0.25]
261	bind $c <KeyPress-Left> [list %W xview scroll 10 units]
262	bind $c <KeyPress-Right> [list %W xview scroll -10 units]
263	bind $c <KeyPress-Up> [list %W yview scroll 10 units]
264	bind $c <KeyPress-Down> [list %W yview scroll -10 units]
265	bind $c <Enter> "focus %W"
266	bind $c <Control-F1> [itcl::code $this ToggleConsole]
267
268	# Fix the scrollregion in case we go off screen
269	$c configure -scrollregion [$c bbox all]
270
271	set _map(id) [$c create image 0 0 -anchor nw -image $_image(plot)]
272	set _map(cwidth) -1
273	set _map(cheight) -1
274	set _map(zoom) 1.0
275	set _map(original) ""
276
277	set f [$itk_component(main) component controls]
278	itk_component add reset {
279	button $f.reset -borderwidth 1 -padx 1 -pady 1 \
280	-highlightthickness 0 \
281	-image [Rappture::icon reset-view] \
282	-command [itcl::code $this Zoom reset]
283	} {
284	usual
285	ignore -highlightthickness
286	}
287	pack $itk_component(reset) -side top -padx 2 -pady 2
288	Rappture::Tooltip::for $itk_component(reset) \
289	"Reset the view to the default zoom level"
290
291	itk_component add zoomin {
292	button $f.zin -borderwidth 1 -padx 1 -pady 1 \
293	-highlightthickness 0 \
294	-image [Rappture::icon zoom-in] \
295	-command [itcl::code $this Zoom in]
296	} {
297	usual
298	ignore -highlightthickness
299	}
300	pack $itk_component(zoomin) -side top -padx 2 -pady 2
301	Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
302
303	itk_component add zoomout {
304	button $f.zout -borderwidth 1 -padx 1 -pady 1 \
305	-highlightthickness 0 \
306	-image [Rappture::icon zoom-out] \
307	-command [itcl::code $this Zoom out]
308	} {
309	usual
310	ignore -highlightthickness
311	}
312	pack $itk_component(zoomout) -side top -padx 2 -pady 2
313	Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
314
315	itk_component add surface {
316	Rappture::PushButton $f.surface \
317	-onimage [Rappture::icon volume-on] \
318	-offimage [Rappture::icon volume-off] \
319	-variable [itcl::scope _settings(-surfacevisible)] \
320	-command [itcl::code $this AdjustSetting -surfacevisible]
321	}
322	$itk_component(surface) select
323	Rappture::Tooltip::for $itk_component(surface) \
324	"Hide the surface"
325	pack $itk_component(surface) -padx 2 -pady 2
326
327	if { [catch {
328	BuildSurfaceTab
329	BuildAxisTab
330	BuildCameraTab
331	} errs] != 0 } {
332	puts stderr errs=$errs
333	}
334
335	# Legend
336	set _image(legend) [image create photo]
337	itk_component add legend {
338	canvas $itk_component(plotarea).legend -width 50 -highlightthickness 0
339	} {
340	usual
341	ignore -highlightthickness
342	rename -background -plotbackground plotBackground Background
343	}
344
345	# Hack around the Tk panewindow. The problem is that the requested
346	# size of the 3d view isn't set until an image is retrieved from
347	# the server. So the panewindow uses the tiny size.
348	set w 10000
349	pack forget $itk_component(view)
350	blt::table $itk_component(plotarea) \
351	0,0 $itk_component(view) -fill both -reqwidth $w
352	blt::table configure $itk_component(plotarea) c1 -resize none
353
354	# Bindings for rotation via mouse
355	bind $itk_component(view) <ButtonPress-1> \
356	[itcl::code $this Rotate click %x %y]
357	bind $itk_component(view) <B1-Motion> \
358	[itcl::code $this Rotate drag %x %y]
359	bind $itk_component(view) <ButtonRelease-1> \
360	[itcl::code $this Rotate release %x %y]
361
362	# Bindings for panning via mouse
363	bind $itk_component(view) <ButtonPress-2> \
364	[itcl::code $this Pan click %x %y]
365	bind $itk_component(view) <B2-Motion> \
366	[itcl::code $this Pan drag %x %y]
367	bind $itk_component(view) <ButtonRelease-2> \
368	[itcl::code $this Pan release %x %y]
369
370	#bind $itk_component(view) <ButtonRelease-3> \
371	# [itcl::code $this Pick %x %y]
372
373	# Bindings for panning via keyboard
374	bind $itk_component(view) <KeyPress-Left> \
375	[itcl::code $this Pan set -10 0]
376	bind $itk_component(view) <KeyPress-Right> \
377	[itcl::code $this Pan set 10 0]
378	bind $itk_component(view) <KeyPress-Up> \
379	[itcl::code $this Pan set 0 -10]
380	bind $itk_component(view) <KeyPress-Down> \
381	[itcl::code $this Pan set 0 10]
382	bind $itk_component(view) <Shift-KeyPress-Left> \
383	[itcl::code $this Pan set -2 0]
384	bind $itk_component(view) <Shift-KeyPress-Right> \
385	[itcl::code $this Pan set 2 0]
386	bind $itk_component(view) <Shift-KeyPress-Up> \
387	[itcl::code $this Pan set 0 -2]
388	bind $itk_component(view) <Shift-KeyPress-Down> \
389	[itcl::code $this Pan set 0 2]
390
391	# Bindings for zoom via keyboard
392	bind $itk_component(view) <KeyPress-Prior> \
393	[itcl::code $this Zoom out]
394	bind $itk_component(view) <KeyPress-Next> \
395	[itcl::code $this Zoom in]
396
397	bind $itk_component(view) <Enter> "focus $itk_component(view)"
398
399	if {[string equal "x11" [tk windowingsystem]]} {
400	# Bindings for zoom via mouse
401	bind $itk_component(view) <4> [itcl::code $this Zoom out]
402	bind $itk_component(view) <5> [itcl::code $this Zoom in]
403	}
404
405	set _image(download) [image create photo]
406
407	eval itk_initialize $args
408
409	EnableWaitDialog 900
410	Connect
411	}
412
413	# ----------------------------------------------------------------------
414	# DESTRUCTOR
415	# ----------------------------------------------------------------------
416	itcl::body Rappture::VtkSurfaceViewer::destructor {} {
417	Disconnect
418	image delete $_image(plot)
419	image delete $_image(download)
420	catch { blt::arcball destroy $_arcball }
421	}
422
423	itcl::body Rappture::VtkSurfaceViewer::DoResize {} {
424	if { $_width < 2 } {
425	set _width 500
426	}
427	if { $_height < 2 } {
428	set _height 500
429	}
430	set _start [clock clicks -milliseconds]
431	SendCmd "screen size $_width $_height"
432
433	EventuallyRequestLegend
434	set _resizePending 0
435	}
436
437	itcl::body Rappture::VtkSurfaceViewer::DoRotate {} {
438	SendCmd "camera orient [ViewToQuaternion]"
439	set _rotatePending 0
440	}
441
442	itcl::body Rappture::VtkSurfaceViewer::EventuallyRequestLegend {} {
443	if { !$_legendPending } {
444	set _legendPending 1
445	$_dispatcher event -idle !legend
446	}
447	}
448
449	itcl::body Rappture::VtkSurfaceViewer::EventuallyResize { w h } {
450	set _width $w
451	set _height $h
452	$_arcball resize $w $h
453	if { !$_resizePending } {
454	set _resizePending 1
455	$_dispatcher event -after 400 !resize
456	}
457	}
458
459	set rotate_delay 100
460
461	itcl::body Rappture::VtkSurfaceViewer::EventuallyRotate { q } {
462	QuaternionToView $q
463	if { !$_rotatePending } {
464	set _rotatePending 1
465	global rotate_delay
466	$_dispatcher event -after $rotate_delay !rotate
467	}
468	}
469
470	# ----------------------------------------------------------------------
471	# USAGE: add <dataobj> ?<settings>?
472	#
473	# Clients use this to add a data object to the plot. The optional
474	# <settings> are used to configure the plot. Allowed settings are
475	# -color, -brightness, -width, -linestyle, and -raise.
476	# ----------------------------------------------------------------------
477	itcl::body Rappture::VtkSurfaceViewer::add {dataobj {settings ""}} {
478	if { ![$dataobj isvalid] } {
479	return; # Object doesn't contain valid data.
480	}
481	array set params {
482	-color auto
483	-width 1
484	-linestyle solid
485	-brightness 0
486	-raise 0
487	-description ""
488	-param ""
489	-type ""
490	}
491	array set params $settings
492	set params(-description) ""
493	set params(-param) ""
494	array set params $settings
495
496	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
497	# can't handle -autocolors yet
498	set params(-color) black
499	}
500	set pos [lsearch -exact $_dlist $dataobj]
501	if {$pos < 0} {
502	lappend _dlist $dataobj
503	}
504	set _obj2ovride($dataobj-color) $params(-color)
505	set _obj2ovride($dataobj-width) $params(-width)
506	set _obj2ovride($dataobj-raise) $params(-raise)
507	$_dispatcher event -idle !rebuild
508	}
509
510	# ----------------------------------------------------------------------
511	# USAGE: delete ?<dataobj1> <dataobj2> ...?
512	#
513	# Clients use this to delete a dataobj from the plot. If no dataobjs
514	# are specified, then all dataobjs are deleted. No data objects are
515	# deleted. They are only removed from the display list.
516	#
517	# ----------------------------------------------------------------------
518	itcl::body Rappture::VtkSurfaceViewer::delete {args} {
519	if { [llength $args] == 0} {
520	set args $_dlist
521	}
522	# Delete all specified dataobjs
523	set changed 0
524	foreach dataobj $args {
525	set pos [lsearch -exact $_dlist $dataobj]
526	if { $pos < 0 } {
527	continue; # Don't know anything about it.
528	}
529	# Remove it from the dataobj list.
530	set _dlist [lreplace $_dlist $pos $pos]
531	array unset _obj2ovride $dataobj-*
532	array unset _settings $dataobj-*
533	set changed 1
534	}
535	# If anything changed, then rebuild the plot
536	if { $changed } {
537	$_dispatcher event -idle !rebuild
538	}
539	}
540
541	# ----------------------------------------------------------------------
542	# USAGE: get ?-objects?
543	# USAGE: get ?-visible?
544	# USAGE: get ?-image view?
545	#
546	# Clients use this to query the list of objects being plotted, in
547	# order from bottom to top of this result. The optional "-image"
548	# flag can also request the internal images being shown.
549	# ----------------------------------------------------------------------
550	itcl::body Rappture::VtkSurfaceViewer::get {args} {
551	if {[llength $args] == 0} {
552	set args "-objects"
553	}
554
555	set op [lindex $args 0]
556	switch -- $op {
557	"-objects" {
558	# put the dataobj list in order according to -raise options
559	set dlist {}
560	foreach dataobj $_dlist {
561	if { ![IsValidObject $dataobj] } {
562	continue
563	}
564	if {[info exists _obj2ovride($dataobj-raise)] &&
565	$_obj2ovride($dataobj-raise)} {
566	set dlist [linsert $dlist 0 $dataobj]
567	} else {
568	lappend dlist $dataobj
569	}
570	}
571	return $dlist
572	}
573	"-visible" {
574	set dlist {}
575	foreach dataobj $_dlist {
576	if { ![IsValidObject $dataobj] } {
577	continue
578	}
579	if { ![info exists _obj2ovride($dataobj-raise)] } {
580	# No setting indicates that the object isn't visible.
581	continue
582	}
583	# Otherwise use the -raise parameter to put the object to
584	# the front of the list.
585	if { $_obj2ovride($dataobj-raise) } {
586	set dlist [linsert $dlist 0 $dataobj]
587	} else {
588	lappend dlist $dataobj
589	}
590	}
591	return $dlist
592	}
593	-image {
594	if {[llength $args] != 2} {
595	error "wrong # args: should be \"get -image view\""
596	}
597	switch -- [lindex $args end] {
598	view {
599	return $_image(plot)
600	}
601	default {
602	error "bad image name \"[lindex $args end]\": should be view"
603	}
604	}
605	}
606	default {
607	error "bad option \"$op\": should be -objects or -image"
608	}
609	}
610	}
611
612	# ----------------------------------------------------------------------
613	# USAGE: scale ?<data1> <data2> ...?
614	#
615	# Sets the default limits for the overall plot according to the
616	# limits of the data for all of the given <data> objects. This
617	# accounts for all objects--even those not showing on the screen.
618	# Because of this, the limits are appropriate for all objects as
619	# the user scans through data in the ResultSet viewer.
620	# ----------------------------------------------------------------------
621	itcl::body Rappture::VtkSurfaceViewer::scale { args } {
622	foreach dataobj $args {
623	if { ![$dataobj isvalid] } {
624	continue; # Object doesn't contain valid data.
625	}
626	foreach axis { x y z } {
627	set lim [$dataobj limits $axis]
628	if { ![info exists _limits($axis)] } {
629	set _limits($axis) $lim
630	continue
631	}
632	foreach {min max} $lim break
633	foreach {amin amax} $_limits($axis) break
634	if { $amin > $min } {
635	set amin $min
636	}
637	if { $amax < $max } {
638	set amax $max
639	}
640	set _limits($axis) [list $amin $amax]
641	}
642	foreach { fname lim } [$dataobj fieldlimits] {
643	if { ![info exists _limits($fname)] } {
644	set _limits($fname) $lim
645	continue
646	}
647	foreach {min max} $lim break
648	foreach {fmin fmax} $_limits($fname) break
649	if { $fmin > $min } {
650	set fmin $min
651	}
652	if { $fmax < $max } {
653	set fmax $max
654	}
655	set _limits($fname) [list $fmin $fmax]
656	}
657	}
658	}
659
660	# ----------------------------------------------------------------------
661	# USAGE: download coming
662	# USAGE: download controls <downloadCommand>
663	# USAGE: download now
664	#
665	# Clients use this method to create a downloadable representation
666	# of the plot. Returns a list of the form {ext string}, where
667	# "ext" is the file extension (indicating the type of data) and
668	# "string" is the data itself.
669	# ----------------------------------------------------------------------
670	itcl::body Rappture::VtkSurfaceViewer::download {option args} {
671	switch $option {
672	coming {
673	if {[catch {
674	blt::winop snap $itk_component(plotarea) $_image(download)
675	}]} {
676	$_image(download) configure -width 1 -height 1
677	$_image(download) put #000000
678	}
679	}
680	controls {
681	set popup .vtkviewerdownload
682	if { ![winfo exists .vtkviewerdownload] } {
683	set inner [BuildDownloadPopup $popup [lindex $args 0]]
684	} else {
685	set inner [$popup component inner]
686	}
687	set _downloadPopup(image_controls) $inner.image_frame
688	set num [llength [get]]
689	set num [expr {($num == 1) ? "1 result" : "$num results"}]
690	set word [Rappture::filexfer::label downloadWord]
691	$inner.summary configure -text "$word $num in the following format:"
692	update idletasks ;# Fix initial sizes
693	return $popup
694	}
695	now {
696	set popup .vtkviewerdownload
697	if {[winfo exists .vtkviewerdownload]} {
698	$popup deactivate
699	}
700	switch -- $_downloadPopup(format) {
701	"image" {
702	return [$this GetImage [lindex $args 0]]
703	}
704	"vtk" {
705	return [$this GetVtkData [lindex $args 0]]
706	}
707	}
708	return ""
709	}
710	default {
711	error "bad option \"$option\": should be coming, controls, now"
712	}
713	}
714	}
715
716	# ----------------------------------------------------------------------
717	# USAGE: Connect ?<host:port>,<host:port>...?
718	#
719	# Clients use this method to establish a connection to a new
720	# server, or to reestablish a connection to the previous server.
721	# Any existing connection is automatically closed.
722	# ----------------------------------------------------------------------
723	itcl::body Rappture::VtkSurfaceViewer::Connect {} {
724	set _hosts [GetServerList "vtkvis"]
725	if { "" == $_hosts } {
726	return 0
727	}
728	set _reset 1
729	set result [VisViewer::Connect $_hosts]
730	if { $result } {
731	if { $_reportClientInfo } {
732	# Tell the server the viewer, hub, user and session.
733	# Do this immediately on connect before buffering any commands
734	global env
735
736	set info {}
737	set user "???"
738	if { [info exists env(USER)] } {
739	set user $env(USER)
740	}
741	set session "???"
742	if { [info exists env(SESSION)] } {
743	set session $env(SESSION)
744	}
745	lappend info "version" "$Rappture::version"
746	lappend info "build" "$Rappture::build"
747	lappend info "svnurl" "$Rappture::svnurl"
748	lappend info "installdir" "$Rappture::installdir"
749	lappend info "hub" [exec hostname]
750	lappend info "client" "vtksurfaceviewer"
751	lappend info "user" $user
752	lappend info "session" $session
753	SendCmd "clientinfo [list $info]"
754	}
755
756	set w [winfo width $itk_component(view)]
757	set h [winfo height $itk_component(view)]
758	EventuallyResize $w $h
759	}
760	return $result
761	}
762
763	#
764	# isconnected --
765	#
766	# Indicates if we are currently connected to the visualization server.
767	#
768	itcl::body Rappture::VtkSurfaceViewer::isconnected {} {
769	return [VisViewer::IsConnected]
770	}
771
772	#
773	# disconnect --
774	#
775	itcl::body Rappture::VtkSurfaceViewer::disconnect {} {
776	Disconnect
777	set _reset 1
778	}
779
780	#
781	# Disconnect --
782	#
783	# Clients use this method to disconnect from the current rendering
784	# server.
785	#
786	itcl::body Rappture::VtkSurfaceViewer::Disconnect {} {
787	VisViewer::Disconnect
788
789	$_dispatcher cancel !rebuild
790	$_dispatcher cancel !resize
791	$_dispatcher cancel !rotate
792	$_dispatcher cancel !legend
793	# disconnected -- no more data sitting on server
794	array unset _datasets
795	array unset _data
796	array unset _colormaps
797	array unset _dataset2style
798	array unset _obj2datasets
799	}
800
801	# ----------------------------------------------------------------------
802	# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
803	#
804	# Invoked automatically whenever the "image" command comes in from
805	# the rendering server. Indicates that binary image data with the
806	# specified <size> will follow.
807	# ----------------------------------------------------------------------
808	itcl::body Rappture::VtkSurfaceViewer::ReceiveImage { args } {
809	array set info {
810	-token "???"
811	-bytes 0
812	-type image
813	}
814	array set info $args
815	set bytes [ReceiveBytes $info(-bytes)]
816	if { $info(-type) == "image" } {
817	if 0 {
818	set f [open "last.ppm" "w"]
819	fconfigure $f -encoding binary
820	puts -nonewline $f $bytes
821	close $f
822	}
823	$_image(plot) configure -data $bytes
824	#set time [clock seconds]
825	#set date [clock format $time]
826	#set w [image width $_image(plot)]
827	#set h [image height $_image(plot)]
828	#puts stderr "$date: received image ${w}x${h} image"
829	if { $_start > 0 } {
830	set finish [clock clicks -milliseconds]
831	#puts stderr "round trip time [expr $finish -$_start] milliseconds"
832	set _start 0
833	}
834	} elseif { $info(type) == "print" } {
835	set tag $this-print-$info(-token)
836	set _hardcopy($tag) $bytes
837	}
838	}
839
840	#
841	# ReceiveDataset --
842	#
843	itcl::body Rappture::VtkSurfaceViewer::ReceiveDataset { args } {
844	if { ![isconnected] } {
845	return
846	}
847	set option [lindex $args 0]
848	switch -- $option {
849	"scalar" {
850	set option [lindex $args 1]
851	switch -- $option {
852	"world" {
853	foreach { x y z value tag } [lrange $args 2 end] break
854	}
855	"pixel" {
856	foreach { x y value tag } [lrange $args 2 end] break
857	}
858	}
859	}
860	"vector" {
861	set option [lindex $args 1]
862	switch -- $option {
863	"world" {
864	foreach { x y z vx vy vz tag } [lrange $args 2 end] break
865	}
866	"pixel" {
867	foreach { x y vx vy vz tag } [lrange $args 2 end] break
868	}
869	}
870	}
871	"names" {
872	foreach { name } [lindex $args 1] {
873	#puts stderr "Dataset: $name"
874	}
875	}
876	default {
877	error "unknown dataset option \"$option\" from server"
878	}
879	}
880	}
881
882	# ----------------------------------------------------------------------
883	# USAGE: Rebuild
884	#
885	# Called automatically whenever something changes that affects the
886	# data in the widget. Clears any existing data and rebuilds the
887	# widget to display new data.
888	# ----------------------------------------------------------------------
889	itcl::body Rappture::VtkSurfaceViewer::Rebuild {} {
890	set w [winfo width $itk_component(view)]
891	set h [winfo height $itk_component(view)]
892	if { $w < 2 \|\| $h < 2 } {
893	update
894	$_dispatcher event -idle !rebuild
895	return
896	}
897
898	# Turn on buffering of commands to the server. We don't want to
899	# be preempted by a server disconnect/reconnect (which automatically
900	# generates a new call to Rebuild).
901	StartBufferingCommands
902
903	if { $_reset } {
904	set _width $w
905	set _height $h
906	$_arcball resize $w $h
907	DoResize
908	# Reset the camera and other view parameters
909	$_arcball quaternion [ViewToQuaternion]
910	if {$_view(-ortho)} {
911	SendCmd "camera mode ortho"
912	} else {
913	SendCmd "camera mode persp"
914	}
915	DoRotate
916	PanCamera
917	set _first ""
918	InitSettings -xgrid -ygrid -zgrid -axismode \
919	-axesvisible -axislabels -axisminorticks
920	#SendCmd "axis lformat all %g"
921	StopBufferingCommands
922	SendCmd "imgflush"
923	StartBufferingCommands
924	}
925	set _first ""
926	SendCmd "dataset visible 0"
927	eval scale $_dlist
928	foreach dataobj [get -objects] {
929	if { [info exists _obj2ovride($dataobj-raise)] && $_first == "" } {
930	set _first $dataobj
931	SetCurrentFieldName $dataobj
932	}
933	set _obj2datasets($dataobj) ""
934	foreach comp [$dataobj components] {
935	set tag $dataobj-$comp
936	if { ![info exists _datasets($tag)] } {
937	set bytes [$dataobj vtkdata $comp]
938	if 0 {
939	set f [open "/tmp/surface.vtk" "w"]
940	fconfigure $f -translation binary -encoding binary
941	puts -nonewline $f $bytes
942	close $f
943	}
944	set length [string length $bytes]
945	if { $_reportClientInfo } {
946	set info {}
947	lappend info "tool_id" [$dataobj hints toolid]
948	lappend info "tool_name" [$dataobj hints toolname]
949	lappend info "tool_title" [$dataobj hints tooltitle]
950	lappend info "tool_command" [$dataobj hints toolcommand]
951	lappend info "tool_revision" [$dataobj hints toolrevision]
952	lappend info "dataset_label" [$dataobj hints label]
953	lappend info "dataset_size" $length
954	lappend info "dataset_tag" $tag
955	SendCmd "clientinfo [list $info]"
956	}
957	SendCmd "dataset add $tag data follows $length"
958	SendData $bytes
959	set _datasets($tag) 1
960	SetObjectStyle $dataobj $comp
961	}
962	lappend _obj2datasets($dataobj) $tag
963	if { [info exists _obj2ovride($dataobj-raise)] } {
964	SendCmd "polydata visible 1 $tag"
965	}
966	}
967	}
968
969	InitSettings -isolinesvisible -surfacevisible -outline
970	if { $_reset } {
971	# These are settings that rely on a dataset being loaded.
972	InitSettings \
973	-surfacelighting \
974	-field \
975	-surfaceedges -surfacelighting -surfaceopacity \
976	-surfacewireframe \
977	-numcontours
978
979	Zoom reset
980	foreach axis { x y z } {
981	set label ""
982	if { $_first != "" } {
983	set label [$_first hints ${axis}label]
984	}
985	if { $label == "" } {
986	set label [string toupper $axis]
987	}
988	# May be a space in the axis label.
989	SendCmd [list axis name $axis $label]
990	}
991	if { [array size _fields] < 2 } {
992	catch {blt::table forget $itk_component(field) $itk_component(field_l)}
993	}
994	set _reset 0
995	}
996	# Redraw the legend even if we're using the same colormap. The position
997	# of the isolines may have changed because the range of data changed.
998	DrawLegend
999
1000	# Actually write the commands to the server socket. If it fails, we don't
1001	# care. We're finished here.
1002	blt::busy hold $itk_component(hull)
1003	StopBufferingCommands; # Turn off buffering and send commands.
1004	blt::busy release $itk_component(hull)
1005	}
1006
1007	# ----------------------------------------------------------------------
1008	# USAGE: CurrentDatasets ?-all -visible? ?dataobjs?
1009	#
1010	# Returns a list of server IDs for the current datasets being displayed. This
1011	# is normally a single ID, but it might be a list of IDs if the current data
1012	# object has multiple components.
1013	# ----------------------------------------------------------------------
1014	itcl::body Rappture::VtkSurfaceViewer::CurrentDatasets {args} {
1015	set flag [lindex $args 0]
1016	switch -- $flag {
1017	"-all" {
1018	if { [llength $args] > 1 } {
1019	error "CurrentDatasets: can't specify dataobj after \"-all\""
1020	}
1021	set dlist [get -objects]
1022	}
1023	"-visible" {
1024	if { [llength $args] > 1 } {
1025	set dlist {}
1026	set args [lrange $args 1 end]
1027	foreach dataobj $args {
1028	if { [info exists _obj2ovride($dataobj-raise)] } {
1029	lappend dlist $dataobj
1030	}
1031	}
1032	} else {
1033	set dlist [get -visible]
1034	}
1035	}
1036	default {
1037	set dlist $args
1038	}
1039	}
1040	set rlist ""
1041	foreach dataobj $dlist {
1042	foreach comp [$dataobj components] {
1043	set tag $dataobj-$comp
1044	if { [info exists _datasets($tag)] && $_datasets($tag) } {
1045	lappend rlist $tag
1046	}
1047	}
1048	}
1049	return $rlist
1050	}
1051
1052	# ----------------------------------------------------------------------
1053	# USAGE: Zoom in
1054	# USAGE: Zoom out
1055	# USAGE: Zoom reset
1056	#
1057	# Called automatically when the user clicks on one of the zoom
1058	# controls for this widget. Changes the zoom for the current view.
1059	# ----------------------------------------------------------------------
1060	itcl::body Rappture::VtkSurfaceViewer::Zoom {option} {
1061	switch -- $option {
1062	"in" {
1063	set _view(-zoom) [expr {$_view(-zoom)*1.25}]
1064	SendCmd "camera zoom $_view(-zoom)"
1065	}
1066	"out" {
1067	set _view(-zoom) [expr {$_view(-zoom)*0.8}]
1068	SendCmd "camera zoom $_view(-zoom)"
1069	}
1070	"reset" {
1071	array set _view {
1072	-qw 0.853553
1073	-qx -0.353553
1074	-qy 0.353553
1075	-qz 0.146447
1076	-xpan 0
1077	-ypan 0
1078	-zoom 1.0
1079	}
1080	if { $_first != "" } {
1081	set location [$_first hints camera]
1082	if { $location != "" } {
1083	array set _view $location
1084	}
1085	}
1086	$_arcball quaternion [ViewToQuaternion]
1087	DoRotate
1088	SendCmd "camera reset"
1089	}
1090	}
1091	}
1092
1093	itcl::body Rappture::VtkSurfaceViewer::PanCamera {} {
1094	set x $_view(-xpan)
1095	set y $_view(-ypan)
1096	SendCmd "camera pan $x $y"
1097	}
1098
1099	# ----------------------------------------------------------------------
1100	# USAGE: Rotate click <x> <y>
1101	# USAGE: Rotate drag <x> <y>
1102	# USAGE: Rotate release <x> <y>
1103	#
1104	# Called automatically when the user clicks/drags/releases in the
1105	# plot area. Moves the plot according to the user's actions.
1106	# ----------------------------------------------------------------------
1107	itcl::body Rappture::VtkSurfaceViewer::Rotate {option x y} {
1108	switch -- $option {
1109	"click" {
1110	$itk_component(view) configure -cursor fleur
1111	set _click(x) $x
1112	set _click(y) $y
1113	}
1114	"drag" {
1115	if {[array size _click] == 0} {
1116	Rotate click $x $y
1117	} else {
1118	set w [winfo width $itk_component(view)]
1119	set h [winfo height $itk_component(view)]
1120	if {$w <= 0 \|\| $h <= 0} {
1121	return
1122	}
1123
1124	if {[catch {
1125	# this fails sometimes for no apparent reason
1126	set dx [expr {double($x-$_click(x))/$w}]
1127	set dy [expr {double($y-$_click(y))/$h}]
1128	}]} {
1129	return
1130	}
1131	if { $dx == 0 && $dy == 0 } {
1132	return
1133	}
1134	set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1135	EventuallyRotate $q
1136	set _click(x) $x
1137	set _click(y) $y
1138	}
1139	}
1140	"release" {
1141	Rotate drag $x $y
1142	$itk_component(view) configure -cursor ""
1143	catch {unset _click}
1144	}
1145	default {
1146	error "bad option \"$option\": should be click, drag, release"
1147	}
1148	}
1149	}
1150
1151	itcl::body Rappture::VtkSurfaceViewer::Pick {x y} {
1152	foreach tag [CurrentDatasets -visible] {
1153	SendCmd "dataset getscalar pixel $x $y $tag"
1154	}
1155	}
1156
1157	# ----------------------------------------------------------------------
1158	# USAGE: $this Pan click x y
1159	# $this Pan drag x y
1160	# $this Pan release x y
1161	#
1162	# Called automatically when the user clicks on one of the zoom
1163	# controls for this widget. Changes the zoom for the current view.
1164	# ----------------------------------------------------------------------
1165	itcl::body Rappture::VtkSurfaceViewer::Pan {option x y} {
1166	switch -- $option {
1167	"set" {
1168	set w [winfo width $itk_component(view)]
1169	set h [winfo height $itk_component(view)]
1170	set x [expr $x / double($w)]
1171	set y [expr $y / double($h)]
1172	set _view(-xpan) [expr $_view(-xpan) + $x]
1173	set _view(-ypan) [expr $_view(-ypan) + $y]
1174	PanCamera
1175	return
1176	}
1177	"click" {
1178	set _click(x) $x
1179	set _click(y) $y
1180	$itk_component(view) configure -cursor hand1
1181	}
1182	"drag" {
1183	if { ![info exists _click(x)] } {
1184	set _click(x) $x
1185	}
1186	if { ![info exists _click(y)] } {
1187	set _click(y) $y
1188	}
1189	set w [winfo width $itk_component(view)]
1190	set h [winfo height $itk_component(view)]
1191	set dx [expr ($_click(x) - $x)/double($w)]
1192	set dy [expr ($_click(y) - $y)/double($h)]
1193	set _click(x) $x
1194	set _click(y) $y
1195	set _view(-xpan) [expr $_view(-xpan) - $dx]
1196	set _view(-ypan) [expr $_view(-ypan) - $dy]
1197	PanCamera
1198	}
1199	"release" {
1200	Pan drag $x $y
1201	$itk_component(view) configure -cursor ""
1202	}
1203	default {
1204	error "unknown option \"$option\": should set, click, drag, or release"
1205	}
1206	}
1207	}
1208
1209	# ----------------------------------------------------------------------
1210	# USAGE: InitSettings <what> ?<value>?
1211	#
1212	# Used internally to update rendering settings whenever parameters
1213	# change in the popup settings panel. Sends the new settings off
1214	# to the back end.
1215	# ----------------------------------------------------------------------
1216	itcl::body Rappture::VtkSurfaceViewer::InitSettings { args } {
1217	foreach spec $args {
1218	if { [info exists _settings($_first-$spec)] } {
1219	# Reset global setting with dataobj specific setting
1220	set _settings($spec) $_settings($_first-$spec)
1221	}
1222	AdjustSetting $spec
1223	}
1224	}
1225
1226	#
1227	# AdjustSetting --
1228	#
1229	# Changes/updates a specific setting in the widget. There are
1230	# usually user-setable option. Commands are sent to the render
1231	# server.
1232	#
1233	itcl::body Rappture::VtkSurfaceViewer::AdjustSetting {what {value ""}} {
1234	if { ![isconnected] } {
1235	return
1236	}
1237	switch -- $what {
1238	"-axesvisible" {
1239	set bool $_settings($what)
1240	SendCmd "axis visible all $bool"
1241	}
1242	"-axislabels" {
1243	set bool $_settings($what)
1244	SendCmd "axis labels all $bool"
1245	}
1246	"-axisminorticks" {
1247	set bool $_settings($what)
1248	SendCmd "axis minticks all $bool"
1249	}
1250	"-axismode" {
1251	set mode [$itk_component(axisMode) value]
1252	set mode [$itk_component(axisMode) translate $mode]
1253	set _settings($what) $mode
1254	SendCmd "axis flymode $mode"
1255	}
1256	"-background" {
1257	set bgcolor [$itk_component(background) value]
1258	array set fgcolors {
1259	"black" "white"
1260	"white" "black"
1261	"grey" "black"
1262	}
1263	configure -plotbackground $bgcolor \
1264	-plotforeground $fgcolors($bgcolor)
1265	$itk_component(view) delete "legend"
1266	DrawLegend
1267	}
1268	"-colormap" {
1269	set _changed($what) 1
1270	StartBufferingCommands
1271	set color [$itk_component(colormap) value]
1272	set _settings($what) $color
1273	if { $color == "none" } {
1274	if { $_settings(-colormapvisible) } {
1275	SendCmd "contour2d colormode constant {}"
1276	SendCmd "polydata colormode constant {}"
1277	set _settings(-colormapvisible) 0
1278	}
1279	} else {
1280	if { !$_settings(-colormapvisible) } {
1281	#SendCmd "contour2d colormode $_colorMode $_curFldName"
1282	SendCmd "polydata colormode $_colorMode $_curFldName"
1283	set _settings(-colormapvisible) 1
1284	}
1285	SetCurrentColormap $color
1286	if {$_settings(-colormapdiscrete)} {
1287	set numColors [expr $_settings(-numcontours) + 1]
1288	SendCmd "colormap res $numColors $color"
1289	}
1290	}
1291	StopBufferingCommands
1292	EventuallyRequestLegend
1293	}
1294	"-colormapdiscrete" {
1295	set bool $_settings($what)
1296	set numColors [expr $_settings(-numcontours) + 1]
1297	StartBufferingCommands
1298	if {$bool} {
1299	SendCmd "colormap res $numColors"
1300	# Discrete colormap requires preinterp on
1301	SendCmd "polydata preinterp on"
1302	} else {
1303	SendCmd "colormap res default"
1304	# FIXME: add setting for preinterp (default on)
1305	SendCmd "polydata preinterp on"
1306	}
1307	StopBufferingCommands
1308	EventuallyRequestLegend
1309	}
1310	"-field" {
1311	set label [$itk_component(field) value]
1312	set fname [$itk_component(field) translate $label]
1313	set _settings($what) $fname
1314	if { [info exists _fields($fname)] } {
1315	foreach { label units components } $_fields($fname) break
1316	if { $components > 1 } {
1317	set _colorMode vmag
1318	} else {
1319	set _colorMode scalar
1320	}
1321	set _curFldName $fname
1322	set _curFldLabel $label
1323	} else {
1324	puts stderr "unknown field \"$fname\""
1325	return
1326	}
1327	SendCmd "dataset scalar $_curFldName"
1328	if { ![info exists _limits($_curFldName)] } {
1329	SendCmd "dataset maprange all"
1330	} else {
1331	SendCmd "dataset maprange explicit $_limits($_curFldName) $_curFldName"
1332	}
1333	#SendCmd "contour2d colormode $_colorMode $_curFldName"
1334	SendCmd "polydata colormode $_colorMode $_curFldName"
1335	SendCmd "camera reset"
1336	UpdateContourList
1337	DrawLegend
1338	}
1339	"-isolinecolor" {
1340	set _changed($what) 1
1341	set color [$itk_component(isolineColor) value]
1342	set _settings($what) $color
1343	SendCmd "contour2d linecolor [Color2RGB $color]"
1344	DrawLegend
1345	}
1346	"-isolinesvisible" {
1347	set _changed($what) 1
1348	set bool $_settings($what)
1349	SendCmd "contour2d visible 0"
1350	if { $bool } {
1351	foreach tag [CurrentDatasets -visible] {
1352	SendCmd "contour2d visible $bool $tag"
1353	}
1354	}
1355	DrawLegend
1356	}
1357	"-legendvisible" {
1358	if { !$_settings($what) } {
1359	$itk_component(view) delete legend
1360	}
1361	DrawLegend
1362	}
1363	"-numcontours" {
1364	set _settings($what) [$itk_component(numcontours) value]
1365	set _currentNumContours $_settings($what)
1366	UpdateContourList
1367	set _changed($what) 1
1368	SendCmd "contour2d contourlist [list $_contourList]"
1369	if {$_settings(-colormapdiscrete)} {
1370	set numColors [expr $_settings($what) + 1]
1371	SendCmd "colormap res $numColors"
1372	EventuallyRequestLegend
1373	} else {
1374	DrawLegend
1375	}
1376	}
1377	"-outline" {
1378	set _changed($what) 1
1379	set bool $_settings($what)
1380	SendCmd "outline visible 0"
1381	if { $bool } {
1382	foreach tag [CurrentDatasets -visible] {
1383	SendCmd "outline visible $bool $tag"
1384	}
1385	}
1386	}
1387	"-surfaceedges" {
1388	set _changed($what) 1
1389	set bool $_settings($what)
1390	SendCmd "polydata edges $bool"
1391	}
1392	"-surfacelighting" {
1393	set _changed($what) 1
1394	set bool $_settings($what)
1395	SendCmd "polydata lighting $bool"
1396	}
1397	"-surfaceopacity" {
1398	set _changed($what) 1
1399	set val $_settings($what)
1400	set sval [expr { 0.01 * double($val) }]
1401	SendCmd "polydata opacity $sval"
1402	}
1403	"-surfacevisible" {
1404	set _changed($what) 1
1405	set bool $_settings($what)
1406	SendCmd "polydata visible 0"
1407	if { $bool } {
1408	foreach tag [CurrentDatasets -visible] {
1409	SendCmd "polydata visible $bool $tag"
1410	}
1411	Rappture::Tooltip::for $itk_component(surface) \
1412	"Hide the surface"
1413	} else {
1414	Rappture::Tooltip::for $itk_component(surface) \
1415	"Show the surface"
1416	}
1417	DrawLegend
1418	}
1419	"-surfacewireframe" {
1420	set _changed($what) 1
1421	set bool $_settings($what)
1422	SendCmd "polydata wireframe $bool"
1423	}
1424	"-xgrid" - "-ygrid" - "-zgrid" {
1425	set axis [string tolower [string range $what 1 1]]
1426	set bool $_settings($what)
1427	SendCmd "axis grid $axis $bool"
1428	}
1429	default {
1430	error "don't know how to fix $what"
1431	}
1432	}
1433	}
1434
1435	#
1436	# RequestLegend --
1437	#
1438	# Request a new legend from the server. The size of the legend
1439	# is determined from the height of the canvas.
1440	#
1441	# This should be called when
1442	# 1. A new current colormap is set.
1443	# 2. Window is resized.
1444	# 3. The limits of the data have changed. (Just need a redraw).
1445	# 4. Number of isolines have changed. (Just need a redraw).
1446	# 5. Legend becomes visible (Just need a redraw).
1447	#
1448	itcl::body Rappture::VtkSurfaceViewer::RequestLegend {} {
1449	set _legendPending 0
1450	if { ![info exists _fields($_curFldName)] } {
1451	return
1452	}
1453	set fname $_curFldName
1454	set font "Arial 8"
1455	set lineht [font metrics $font -linespace]
1456	set w 12
1457	set h [expr {$_height - 2 * ($lineht + 2)}]
1458	if { $h < 1 } {
1459	return
1460	}
1461	if { [string match "component*" $fname] } {
1462	set title ""
1463	} else {
1464	if { [info exists _fields($fname)] } {
1465	foreach { title units } $_fields($fname) break
1466	if { $units != "" } {
1467	set title [format "%s (%s)" $title $units]
1468	}
1469	} else {
1470	set title $fname
1471	}
1472	}
1473	# If there's a title too, subtract one more line
1474	if { $title != "" } {
1475	incr h -$lineht
1476	}
1477	# Set the legend on the first heightmap dataset.
1478	if { $_currentColormap != "" } {
1479	set cmap $_currentColormap
1480	if { ![info exists _colormaps($cmap)] } {
1481	BuildColormap $cmap
1482	set _colormaps($cmap) 1
1483	}
1484	#SendCmd "legend $cmap scalar $_curFldName {} $w $h 0"
1485	SendCmd "legend2 $cmap $w $h"
1486	}
1487	}
1488
1489	# ----------------------------------------------------------------------
1490	# CONFIGURATION OPTION: -plotbackground
1491	# ----------------------------------------------------------------------
1492	itcl::configbody Rappture::VtkSurfaceViewer::plotbackground {
1493	if { [isconnected] } {
1494	set rgb [Color2RGB $itk_option(-plotbackground)]
1495	SendCmd "screen bgcolor $rgb"
1496	}
1497	}
1498
1499	# ----------------------------------------------------------------------
1500	# CONFIGURATION OPTION: -plotforeground
1501	# ----------------------------------------------------------------------
1502	itcl::configbody Rappture::VtkSurfaceViewer::plotforeground {
1503	if { [isconnected] } {
1504	set rgb [Color2RGB $itk_option(-plotforeground)]
1505	SendCmd "axis color all $rgb"
1506	SendCmd "outline color $rgb"
1507	}
1508	}
1509
1510	itcl::body Rappture::VtkSurfaceViewer::BuildSurfaceTab {} {
1511
1512	set fg [option get $itk_component(hull) font Font]
1513	#set bfg [option get $itk_component(hull) boldFont Font]
1514
1515	set inner [$itk_component(main) insert end \
1516	-title "Surface Settings" \
1517	-icon [Rappture::icon volume-on]]
1518	$inner configure -borderwidth 4
1519
1520	checkbutton $inner.surface \
1521	-text "Surface" \
1522	-variable [itcl::scope _settings(-surfacevisible)] \
1523	-command [itcl::code $this AdjustSetting -surfacevisible] \
1524	-font "Arial 9"
1525
1526	checkbutton $inner.isolines \
1527	-text "Isolines" \
1528	-variable [itcl::scope _settings(-isolinesvisible)] \
1529	-command [itcl::code $this AdjustSetting -isolinesvisible] \
1530	-font "Arial 9"
1531
1532	checkbutton $inner.colormapDiscrete \
1533	-text "Discrete Colormap" \
1534	-variable [itcl::scope _settings(-colormapdiscrete)] \
1535	-command [itcl::code $this AdjustSetting -colormapdiscrete] \
1536	-font "Arial 9"
1537
1538	checkbutton $inner.wireframe \
1539	-text "Wireframe" \
1540	-variable [itcl::scope _settings(-surfacewireframe)] \
1541	-command [itcl::code $this AdjustSetting -surfacewireframe] \
1542	-font "Arial 9"
1543
1544	checkbutton $inner.lighting \
1545	-text "Enable Lighting" \
1546	-variable [itcl::scope _settings(-surfacelighting)] \
1547	-command [itcl::code $this AdjustSetting -surfacelighting] \
1548	-font "Arial 9"
1549
1550	checkbutton $inner.edges \
1551	-text "Edges" \
1552	-variable [itcl::scope _settings(-surfaceedges)] \
1553	-command [itcl::code $this AdjustSetting -surfaceedges] \
1554	-font "Arial 9"
1555
1556	checkbutton $inner.outline \
1557	-text "Outline" \
1558	-variable [itcl::scope _settings(-outline)] \
1559	-command [itcl::code $this AdjustSetting -outline] \
1560	-font "Arial 9"
1561
1562	checkbutton $inner.legend \
1563	-text "Legend" \
1564	-variable [itcl::scope _settings(-legendvisible)] \
1565	-command [itcl::code $this AdjustSetting -legendvisible] \
1566	-font "Arial 9"
1567
1568	label $inner.linecolor_l -text "Isolines" -font "Arial 9"
1569	itk_component add isolineColor {
1570	Rappture::Combobox $inner.linecolor -width 10 -editable 0
1571	}
1572	$inner.linecolor choices insert end \
1573	"black" "black" \
1574	"blue" "blue" \
1575	"cyan" "cyan" \
1576	"green" "green" \
1577	"grey" "grey" \
1578	"magenta" "magenta" \
1579	"orange" "orange" \
1580	"red" "red" \
1581	"white" "white" \
1582	"none" "none"
1583
1584	$itk_component(isolineColor) value "white"
1585	bind $inner.linecolor <<Value>> \
1586	[itcl::code $this AdjustSetting -isolinecolor]
1587
1588	label $inner.background_l -text "Background" -font "Arial 9"
1589	itk_component add background {
1590	Rappture::Combobox $inner.background -width 10 -editable 0
1591	}
1592	$inner.background choices insert end \
1593	"black" "black" \
1594	"white" "white" \
1595	"grey" "grey"
1596
1597	$itk_component(background) value $_settings(-background)
1598	bind $inner.background <<Value>> \
1599	[itcl::code $this AdjustSetting -background]
1600
1601	label $inner.opacity_l -text "Opacity" -font "Arial 9"
1602	::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1603	-variable [itcl::scope _settings(-surfaceopacity)] \
1604	-width 10 \
1605	-showvalue off \
1606	-command [itcl::code $this AdjustSetting -surfaceopacity]
1607
1608	itk_component add field_l {
1609	label $inner.field_l -text "Field" -font "Arial 9"
1610	} {
1611	ignore -font
1612	}
1613	itk_component add field {
1614	Rappture::Combobox $inner.field -width 10 -editable 0
1615	}
1616	bind $inner.field <<Value>> \
1617	[itcl::code $this AdjustSetting -field]
1618
1619	label $inner.colormap_l -text "Colormap" -font "Arial 9"
1620	itk_component add colormap {
1621	Rappture::Combobox $inner.colormap -width 10 -editable 0
1622	}
1623	$inner.colormap choices insert end [GetColormapList]
1624
1625	$itk_component(colormap) value "BCGYR"
1626	bind $inner.colormap <<Value>> \
1627	[itcl::code $this AdjustSetting -colormap]
1628
1629	label $inner.numcontours_l -text "Number of Isolines" -font "Arial 9"
1630	itk_component add numcontours {
1631	Rappture::Spinint $inner.numcontours \
1632	-min 0 -max 50 -font "arial 9"
1633	}
1634	$itk_component(numcontours) value $_settings(-numcontours)
1635	bind $itk_component(numcontours) <<Value>> \
1636	[itcl::code $this AdjustSetting -numcontours]
1637
1638	blt::table $inner \
1639	0,0 $inner.field_l -anchor w -pady 2 \
1640	0,1 $inner.field -anchor w -pady 2 -fill x \
1641	1,0 $inner.colormap_l -anchor w -pady 2 \
1642	1,1 $inner.colormap -anchor w -pady 2 -fill x \
1643	2,0 $inner.linecolor_l -anchor w -pady 2 \
1644	2,1 $inner.linecolor -anchor w -pady 2 -fill x \
1645	3,0 $inner.background_l -anchor w -pady 2 \
1646	3,1 $inner.background -anchor w -pady 2 -fill x \
1647	4,0 $inner.numcontours_l -anchor w -pady 2 \
1648	4,1 $inner.numcontours -anchor w -pady 2 \
1649	5,0 $inner.colormapDiscrete -anchor w -pady 2 -cspan 2 \
1650	6,0 $inner.isolines -anchor w -pady 2 -cspan 2 \
1651	7,0 $inner.wireframe -anchor w -pady 2 -cspan 2 \
1652	8,0 $inner.lighting -anchor w -pady 2 -cspan 2 \
1653	9,0 $inner.edges -anchor w -pady 2 -cspan 2 \
1654	10,0 $inner.outline -anchor w -pady 2 -cspan 2 \
1655	11,0 $inner.legend -anchor w -pady 2 \
1656	12,0 $inner.opacity_l -anchor w -pady 2 \
1657	12,1 $inner.opacity -fill x -pady 2 -fill x \
1658
1659	blt::table configure $inner r* c* -resize none
1660	blt::table configure $inner r13 c1 -resize expand
1661	}
1662
1663	itcl::body Rappture::VtkSurfaceViewer::BuildAxisTab {} {
1664
1665	set fg [option get $itk_component(hull) font Font]
1666	#set bfg [option get $itk_component(hull) boldFont Font]
1667
1668	set inner [$itk_component(main) insert end \
1669	-title "Axis Settings" \
1670	-icon [Rappture::icon axis2]]
1671	$inner configure -borderwidth 4
1672
1673	checkbutton $inner.visible \
1674	-text "Axes" \
1675	-variable [itcl::scope _settings(-axesvisible)] \
1676	-command [itcl::code $this AdjustSetting -axesvisible] \
1677	-font "Arial 9"
1678
1679	checkbutton $inner.labels \
1680	-text "Axis Labels" \
1681	-variable [itcl::scope _settings(-axislabels)] \
1682	-command [itcl::code $this AdjustSetting -axislabels] \
1683	-font "Arial 9"
1684	label $inner.grid_l -text "Grid" -font "Arial 9"
1685	checkbutton $inner.xgrid \
1686	-text "X" \
1687	-variable [itcl::scope _settings(-xgrid)] \
1688	-command [itcl::code $this AdjustSetting -xgrid] \
1689	-font "Arial 9"
1690	checkbutton $inner.ygrid \
1691	-text "Y" \
1692	-variable [itcl::scope _settings(-ygrid)] \
1693	-command [itcl::code $this AdjustSetting -ygrid] \
1694	-font "Arial 9"
1695	checkbutton $inner.zgrid \
1696	-text "Z" \
1697	-variable [itcl::scope _settings(-zgrid)] \
1698	-command [itcl::code $this AdjustSetting -zgrid] \
1699	-font "Arial 9"
1700	checkbutton $inner.minorticks \
1701	-text "Minor Ticks" \
1702	-variable [itcl::scope _settings(-axisminorticks)] \
1703	-command [itcl::code $this AdjustSetting -axisminorticks] \
1704	-font "Arial 9"
1705
1706	label $inner.mode_l -text "Mode" -font "Arial 9"
1707
1708	itk_component add axisMode {
1709	Rappture::Combobox $inner.mode -width 10 -editable 0
1710	}
1711	$inner.mode choices insert end \
1712	"static_triad" "static" \
1713	"closest_triad" "closest" \
1714	"furthest_triad" "farthest" \
1715	"outer_edges" "outer"
1716	$itk_component(axisMode) value $_settings(-axismode)
1717	bind $inner.mode <<Value>> [itcl::code $this AdjustSetting -axismode]
1718
1719	blt::table $inner \
1720	0,0 $inner.visible -anchor w -cspan 4 \
1721	1,0 $inner.labels -anchor w -cspan 4 \
1722	2,0 $inner.minorticks -anchor w -cspan 4 \
1723	4,0 $inner.grid_l -anchor w \
1724	4,1 $inner.xgrid -anchor w \
1725	4,2 $inner.ygrid -anchor w \
1726	4,3 $inner.zgrid -anchor w \
1727	5,0 $inner.mode_l -anchor w -padx { 2 0 } \
1728	5,1 $inner.mode -fill x -cspan 3
1729
1730	blt::table configure $inner r* c* -resize none
1731	blt::table configure $inner r7 c6 -resize expand
1732	blt::table configure $inner r3 -height 0.125i
1733	}
1734
1735	itcl::body Rappture::VtkSurfaceViewer::BuildCameraTab {} {
1736	set inner [$itk_component(main) insert end \
1737	-title "Camera Settings" \
1738	-icon [Rappture::icon camera]]
1739	$inner configure -borderwidth 4
1740
1741	label $inner.view_l -text "view" -font "Arial 9"
1742	set f [frame $inner.view]
1743	foreach side { front back left right top bottom } {
1744	button $f.$side -image [Rappture::icon view$side] \
1745	-command [itcl::code $this SetOrientation $side]
1746	Rappture::Tooltip::for $f.$side "Change the view to $side"
1747	pack $f.$side -side left
1748	}
1749
1750	blt::table $inner \
1751	0,0 $inner.view_l -anchor e -pady 2 \
1752	0,1 $inner.view -anchor w -pady 2
1753	blt::table configure $inner r0 -resize none
1754
1755	set labels { qx qy qz qw xpan ypan zoom }
1756	set row 1
1757	foreach tag $labels {
1758	label $inner.${tag}label -text $tag -font "Arial 9"
1759	entry $inner.${tag} -font "Arial 9" -bg white \
1760	-textvariable [itcl::scope _view(-$tag)]
1761	bind $inner.${tag} <Return> \
1762	[itcl::code $this camera set -${tag}]
1763	bind $inner.${tag} <KP_Enter> \
1764	[itcl::code $this camera set -${tag}]
1765	blt::table $inner \
1766	$row,0 $inner.${tag}label -anchor e -pady 2 \
1767	$row,1 $inner.${tag} -anchor w -pady 2
1768	blt::table configure $inner r$row -resize none
1769	incr row
1770	}
1771	checkbutton $inner.ortho \
1772	-text "Orthographic Projection" \
1773	-variable [itcl::scope _view(-ortho)] \
1774	-command [itcl::code $this camera set -ortho] \
1775	-font "Arial 9"
1776	blt::table $inner \
1777	$row,0 $inner.ortho -cspan 2 -anchor w -pady 2
1778	blt::table configure $inner r$row -resize none
1779	incr row
1780
1781	blt::table configure $inner c* -resize none
1782	blt::table configure $inner c2 -resize expand
1783	blt::table configure $inner r$row -resize expand
1784	}
1785
1786	#
1787	# camera --
1788	#
1789	itcl::body Rappture::VtkSurfaceViewer::camera {option args} {
1790	switch -- $option {
1791	"show" {
1792	puts [array get _view]
1793	}
1794	"set" {
1795	set what [lindex $args 0]
1796	set x $_view($what)
1797	set code [catch { string is double $x } result]
1798	if { $code != 0 \|\| !$result } {
1799	return
1800	}
1801	switch -- $what {
1802	"-ortho" {
1803	if {$_view($what)} {
1804	SendCmd "camera mode ortho"
1805	} else {
1806	SendCmd "camera mode persp"
1807	}
1808	}
1809	"-xpan" - "-ypan" {
1810	PanCamera
1811	}
1812	"-qx" - "-qy" - "-qz" - "-qw" {
1813	set q [ViewToQuaternion]
1814	$_arcball quaternion $q
1815	EventuallyRotate $q
1816	}
1817	"-zoom" {
1818	SendCmd "camera zoom $_view($what)"
1819	}
1820	}
1821	}
1822	}
1823	}
1824
1825	itcl::body Rappture::VtkSurfaceViewer::GetVtkData { args } {
1826	set bytes ""
1827	foreach dataobj [get] {
1828	foreach cname [$dataobj components] {
1829	set tag $dataobj-$cname
1830	set contents [$dataobj vtkdata $cname]
1831	append bytes "$contents\n"
1832	}
1833	}
1834	return [list .vtk $bytes]
1835	}
1836
1837	itcl::body Rappture::VtkSurfaceViewer::GetImage { args } {
1838	if { [image width $_image(download)] > 0 &&
1839	[image height $_image(download)] > 0 } {
1840	set bytes [$_image(download) data -format "jpeg -quality 100"]
1841	set bytes [Rappture::encoding::decode -as b64 $bytes]
1842	return [list .jpg $bytes]
1843	}
1844	return ""
1845	}
1846
1847	itcl::body Rappture::VtkSurfaceViewer::BuildDownloadPopup { popup command } {
1848	Rappture::Balloon $popup \
1849	-title "[Rappture::filexfer::label downloadWord] as..."
1850	set inner [$popup component inner]
1851	label $inner.summary -text "" -anchor w
1852	radiobutton $inner.vtk_button -text "VTK data file" \
1853	-variable [itcl::scope _downloadPopup(format)] \
1854	-font "Arial 9 " \
1855	-value vtk
1856	Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
1857	radiobutton $inner.image_button -text "Image File" \
1858	-variable [itcl::scope _downloadPopup(format)] \
1859	-font "Arial 9 " \
1860	-value image
1861	Rappture::Tooltip::for $inner.image_button \
1862	"Save as digital image."
1863
1864	button $inner.ok -text "Save" \
1865	-highlightthickness 0 -pady 2 -padx 3 \
1866	-command $command \
1867	-compound left \
1868	-image [Rappture::icon download]
1869
1870	button $inner.cancel -text "Cancel" \
1871	-highlightthickness 0 -pady 2 -padx 3 \
1872	-command [list $popup deactivate] \
1873	-compound left \
1874	-image [Rappture::icon cancel]
1875
1876	blt::table $inner \
1877	0,0 $inner.summary -cspan 2 \
1878	1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
1879	2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
1880	4,1 $inner.cancel -width .9i -fill y \
1881	4,0 $inner.ok -padx 2 -width .9i -fill y
1882	blt::table configure $inner r3 -height 4
1883	blt::table configure $inner r4 -pady 4
1884	raise $inner.image_button
1885	$inner.vtk_button invoke
1886	return $inner
1887	}
1888
1889	itcl::body Rappture::VtkSurfaceViewer::SetObjectStyle { dataobj comp } {
1890	# Parse style string.
1891	set tag $dataobj-$comp
1892	array set style {
1893	-color BCGYR
1894	-edgecolor black
1895	-edges 0
1896	-isolinecolor white
1897	-isolinesvisible 0
1898	-levels 10
1899	-lighting 1
1900	-linewidth 1.0
1901	-opacity 1.0
1902	-outline 0
1903	-surfacevisible 1
1904	-wireframe 0
1905	}
1906	array set style [$dataobj style $comp]
1907	if { $dataobj != $_first \|\| $style(-levels) == 1 } {
1908	set style(-opacity) 1.0
1909	}
1910
1911	# This is too complicated. We want to set the colormap, number of
1912	# isolines and opacity for the dataset. They can be the default values,
1913	# the style hints loaded with the dataset, or set by user controls. As
1914	# datasets get loaded, they first use the defaults that are overidden
1915	# by the style hints. If the user changes the global controls, then that
1916	# overrides everything else. I don't know what it means when global
1917	# controls are specified as style hints by each dataset. It complicates
1918	# the code to handle aberrant cases.
1919
1920	if { $_changed(-surfaceedges) } {
1921	set style(-edges) $_settings(-surfaceedges)
1922	}
1923	if { $_changed(-surfacelighting) } {
1924	set style(-lighting) $_settings(-surfacelighting)
1925	}
1926	if { $_changed(-surfaceopacity) } {
1927	set style(-opacity) [expr $_settings(-surfaceopacity) * 0.01]
1928	}
1929	if { $_changed(-surfacewireframe) } {
1930	set style(-wireframe) $_settings(-surfacewireframe)
1931	}
1932	if { $_changed(-numcontours) } {
1933	set style(-levels) $_settings(-numcontours)
1934	}
1935	if { $_changed(-colormap) } {
1936	set style(-color) $_settings(-colormap)
1937	}
1938	if { $_currentColormap == "" } {
1939	SetCurrentColormap $style(-color)
1940	$itk_component(colormap) value $style(-color)
1941	}
1942	if { $_currentNumContours != $style(-levels) } {
1943	set _currentNumContours $style(-levels)
1944	set _settings(-numcontours) $_currentNumContours
1945	$itk_component(numcontours) value $_currentNumContours
1946	UpdateContourList
1947	DrawLegend
1948	}
1949	foreach setting {-outline -isolinesvisible -surfacevisible -isolinecolor} {
1950	if {$_changed($setting)} {
1951	# User-modified UI setting overrides style
1952	set style($setting) $_settings($setting)
1953	} else {
1954	# Set UI control to style setting (tool provided or default)
1955	set _settings($setting) $style($setting)
1956	}
1957	}
1958
1959	SendCmd "outline add $tag"
1960	SendCmd "outline color [Color2RGB $itk_option(-plotforeground)] $tag"
1961	SendCmd "outline visible $style(-outline) $tag"
1962
1963	SendCmd "polydata add $tag"
1964	if { $_curFldName != "" } {
1965	SendCmd "polydata colormode $_colorMode $_curFldName $tag"
1966	}
1967	SendCmd "polydata edges $style(-edges) $tag"
1968	set _settings(-surfaceedges) $style(-edges)
1969	#SendCmd "polydata color [Color2RGB $settings(-color)] $tag"
1970	SendCmd "polydata lighting $style(-lighting) $tag"
1971	set _settings(-surfacelighting) $style(-lighting)
1972	SendCmd "polydata linecolor [Color2RGB $style(-edgecolor)] $tag"
1973	SendCmd "polydata linewidth $style(-linewidth) $tag"
1974	SendCmd "polydata opacity $style(-opacity) $tag"
1975	set _settings(-surfaceopacity) [expr $style(-opacity) * 100.0]
1976	SetCurrentColormap $style(-color)
1977	SendCmd "polydata wireframe $style(-wireframe) $tag"
1978	set _settings(-surfacewireframe) $style(-wireframe)
1979
1980	SendCmd [list contour2d add contourlist $_contourList $tag]
1981	SendCmd "contour2d colormode constant {} $tag"
1982	SendCmd "contour2d color [Color2RGB $style(-isolinecolor)] $tag"
1983	}
1984
1985	itcl::body Rappture::VtkSurfaceViewer::IsValidObject { dataobj } {
1986	if {[catch {$dataobj isa Rappture::Field} valid] != 0 \|\| !$valid} {
1987	return 0
1988	}
1989	return 1
1990	}
1991
1992	#
1993	# EnterLegend --
1994	#
1995	itcl::body Rappture::VtkSurfaceViewer::EnterLegend { x y } {
1996	SetLegendTip $x $y
1997	}
1998
1999	#
2000	# MotionLegend --
2001	#
2002	itcl::body Rappture::VtkSurfaceViewer::MotionLegend { x y } {
2003	Rappture::Tooltip::tooltip cancel
2004	set c $itk_component(view)
2005	set cw [winfo width $c]
2006	set ch [winfo height $c]
2007	if { $x >= 0 && $x < $cw && $y >= 0 && $y < $ch } {
2008	SetLegendTip $x $y
2009	}
2010	}
2011
2012	#
2013	# LeaveLegend --
2014	#
2015	itcl::body Rappture::VtkSurfaceViewer::LeaveLegend { } {
2016	Rappture::Tooltip::tooltip cancel
2017	.rappturetooltip configure -icon ""
2018	}
2019
2020	#
2021	# SetLegendTip --
2022	#
2023	itcl::body Rappture::VtkSurfaceViewer::SetLegendTip { x y } {
2024	set fname $_curFldName
2025	set c $itk_component(view)
2026	set w [winfo width $c]
2027	set h [winfo height $c]
2028
2029	set font "Arial 8"
2030	set lineht [font metrics $font -linespace]
2031
2032	set ih [image height $_image(legend)]
2033	set iy [expr $y - ($lineht + 2)]
2034
2035	if { [string match "component*" $fname] } {
2036	set title ""
2037	} else {
2038	if { [info exists _fields($fname)] } {
2039	foreach { title units } $_fields($fname) break
2040	if { $units != "" } {
2041	set title [format "%s (%s)" $title $units]
2042	}
2043	} else {
2044	set title $fname
2045	}
2046	}
2047	# If there's a legend title, increase the offset by the line height.
2048	if { $title != "" } {
2049	incr iy -$lineht
2050	}
2051	# Make a swatch of the selected color
2052	if { [catch { $_image(legend) get 10 $iy } pixel] != 0 } {
2053	return
2054	}
2055	if { ![info exists _image(swatch)] } {
2056	set _image(swatch) [image create photo -width 24 -height 24]
2057	}
2058	set color [eval format "\#%02x%02x%02x" $pixel]
2059	$_image(swatch) put black -to 0 0 23 23
2060	$_image(swatch) put $color -to 1 1 22 22
2061	.rappturetooltip configure -icon $_image(swatch)
2062
2063	# Compute the value of the point
2064	if { [info exists _limits($_curFldName)] } {
2065	foreach { vmin vmax } $_limits($_curFldName) break
2066	set t [expr 1.0 - (double($iy) / double($ih-1))]
2067	set value [expr $t * ($vmax - $vmin) + $vmin]
2068	} else {
2069	set value 0.0
2070	}
2071	set tx [expr $x + 15]
2072	set ty [expr $y - 5]
2073	if { [info exists _isolines($y)] } {
2074	Rappture::Tooltip::text $c [format "$title %g (isoline)" $_isolines($y)]
2075	} else {
2076	Rappture::Tooltip::text $c [format "$title %g" $value]
2077	}
2078	Rappture::Tooltip::tooltip show $c +$tx,+$ty
2079	}
2080
2081	#
2082	# ReceiveLegend --
2083	#
2084	# Invoked automatically whenever the "legend" command comes in from
2085	# the rendering server. Indicates that binary image data with the
2086	# specified <size> will follow.
2087	#
2088	itcl::body Rappture::VtkSurfaceViewer::ReceiveLegend { colormap title min max size } {
2089	#puts stderr "ReceiveLegend colormap=$colormap title=$title range=$min,$max size=$size"
2090	set _title $title
2091	regsub {\(mag\)} $title "" _title
2092	if { [IsConnected] } {
2093	set bytes [ReceiveBytes $size]
2094	if { ![info exists _image(legend)] } {
2095	set _image(legend) [image create photo]
2096	}
2097	$_image(legend) configure -data $bytes
2098	#puts stderr "read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
2099	if { [catch {DrawLegend} errs] != 0 } {
2100	global errorInfo
2101	puts stderr "errs=$errs errorInfo=$errorInfo"
2102	}
2103	}
2104	}
2105
2106	#
2107	# DrawLegend --
2108	#
2109	# Draws the legend in the own canvas on the right side of the plot area.
2110	#
2111	itcl::body Rappture::VtkSurfaceViewer::DrawLegend {} {
2112	set fname $_curFldName
2113	set c $itk_component(view)
2114	set w [winfo width $c]
2115	set h [winfo height $c]
2116	set font "Arial 8"
2117	set lineht [font metrics $font -linespace]
2118
2119	if { [string match "component*" $fname] } {
2120	set title ""
2121	} else {
2122	if { [info exists _fields($fname)] } {
2123	foreach { title units } $_fields($fname) break
2124	if { $units != "" } {
2125	set title [format "%s (%s)" $title $units]
2126	}
2127	} else {
2128	set title $fname
2129	}
2130	}
2131	set x [expr $w - 2]
2132	if { !$_settings(-legendvisible) } {
2133	$c delete legend
2134	return
2135	}
2136	if { [$c find withtag "legend"] == "" } {
2137	set y 2
2138	# If there's a legend title, create a text item for the title.
2139	$c create text $x $y \
2140	-anchor ne \
2141	-fill $itk_option(-plotforeground) -tags "title legend" \
2142	-font $font
2143	if { $title != "" } {
2144	incr y $lineht
2145	}
2146	$c create text $x $y \
2147	-anchor ne \
2148	-fill $itk_option(-plotforeground) -tags "vmax legend" \
2149	-font $font
2150	incr y $lineht
2151	$c create image $x $y \
2152	-anchor ne \
2153	-image $_image(legend) -tags "colormap legend"
2154	$c create rectangle $x $y 1 1 \
2155	-fill "" -outline "" -tags "sensor legend"
2156	$c create text $x [expr {$h-2}] \
2157	-anchor se \
2158	-fill $itk_option(-plotforeground) -tags "vmin legend" \
2159	-font $font
2160	$c bind sensor <Enter> [itcl::code $this EnterLegend %x %y]
2161	$c bind sensor <Leave> [itcl::code $this LeaveLegend]
2162	$c bind sensor <Motion> [itcl::code $this MotionLegend %x %y]
2163	}
2164	$c delete isoline
2165	set x2 $x
2166	set iw [image width $_image(legend)]
2167	set ih [image height $_image(legend)]
2168	set x1 [expr $x2 - ($iw*12)/10]
2169	set color $_settings(-isolinecolor)
2170	# Draw the isolines on the legend.
2171	array unset _isolines
2172	if { $color != "none" && [info exists _limits($_curFldName)] &&
2173	$_settings(-isolinesvisible) && $_settings(-numcontours) > 0 } {
2174
2175	foreach { vmin vmax } $_limits($_curFldName) break
2176	set range [expr double($vmax - $vmin)]
2177	if { $range <= 0.0 } {
2178	set range 1.0; # Min is greater or equal to max.
2179	}
2180	set tags "isoline legend"
2181	set offset [expr 2 + $lineht]
2182	if { $title != "" } {
2183	incr offset $lineht
2184	}
2185	foreach value $_contourList {
2186	set norm [expr 1.0 - (($value - $vmin) / $range)]
2187	set y1 [expr int(round(($norm * $ih) + $offset))]
2188	for { set off 0 } { $off < 3 } { incr off } {
2189	set _isolines([expr $y1 + $off]) $value
2190	set _isolines([expr $y1 - $off]) $value
2191	}
2192	$c create line $x1 $y1 $x2 $y1 -fill $color -tags $tags
2193	}
2194	}
2195
2196	$c bind title <ButtonPress> [itcl::code $this Combo post]
2197	$c bind title <Enter> [itcl::code $this Combo activate]
2198	$c bind title <Leave> [itcl::code $this Combo deactivate]
2199	# Reset the item coordinates according the current size of the plot.
2200	$c itemconfigure title -text $title
2201	if { [info exists _limits($_curFldName)] } {
2202	foreach { vmin vmax } $_limits($_curFldName) break
2203	$c itemconfigure vmin -text [format %g $vmin]
2204	$c itemconfigure vmax -text [format %g $vmax]
2205	}
2206	set y 2
2207	# If there's a legend title, move the title to the correct position
2208	if { $title != "" } {
2209	$c itemconfigure title -text $title
2210	$c coords title $x $y
2211	incr y $lineht
2212	$c raise title
2213	}
2214	$c coords vmax $x $y
2215	incr y $lineht
2216	$c coords colormap $x $y
2217	$c coords sensor [expr $x - $iw] $y $x [expr $y + $ih]
2218	$c raise sensor
2219	$c coords vmin $x [expr {$h - 2}]
2220	}
2221
2222	# ----------------------------------------------------------------------
2223	# USAGE: _dropdown post
2224	# USAGE: _dropdown unpost
2225	# USAGE: _dropdown select
2226	#
2227	# Used internally to handle the dropdown list for this combobox. The
2228	# post/unpost options are invoked when the list is posted or unposted
2229	# to manage the relief of the controlling button. The select option
2230	# is invoked whenever there is a selection from the list, to assign
2231	# the value back to the gauge.
2232	# ----------------------------------------------------------------------
2233	itcl::body Rappture::VtkSurfaceViewer::Combo {option} {
2234	set c $itk_component(view)
2235	switch -- $option {
2236	post {
2237	foreach { x1 y1 x2 y2 } [$c bbox title] break
2238	set cw [winfo width $itk_component(view)]
2239	set mw [winfo reqwidth $itk_component(fieldmenu)]
2240	set x1 [expr $cw - $mw]
2241	set x [expr $x1 + [winfo rootx $itk_component(view)]]
2242	set y [expr $y2 + [winfo rooty $itk_component(view)]]
2243	tk_popup $itk_component(fieldmenu) $x $y
2244	}
2245	activate {
2246	$c itemconfigure title -fill red
2247	}
2248	deactivate {
2249	$c itemconfigure title -fill $itk_option(-plotforeground)
2250	}
2251	invoke {
2252	$itk_component(field) value $_curFldLabel
2253	AdjustSetting -field
2254	}
2255	default {
2256	error "bad option \"$option\": should be post, unpost, select"
2257	}
2258	}
2259	}
2260
2261	#
2262	# SetCurrentColormap --
2263	#
2264	itcl::body Rappture::VtkSurfaceViewer::SetCurrentColormap { name } {
2265	# Keep track of the colormaps that we build.
2266	if { ![info exists _colormaps($name)] } {
2267	BuildColormap $name
2268	set _colormaps($name) 1
2269	}
2270	set _currentColormap $name
2271	SendCmd "contour2d colormap $_currentColormap"
2272	SendCmd "polydata colormap $_currentColormap"
2273	}
2274
2275	#
2276	# BuildColormap --
2277	#
2278	# Build the designated colormap on the server.
2279	#
2280	itcl::body Rappture::VtkSurfaceViewer::BuildColormap { name } {
2281	set cmap [ColorsToColormap $name]
2282	if { [llength $cmap] == 0 } {
2283	set cmap "0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0"
2284	}
2285	set amap "0.0 1.0 1.0 1.0"
2286	SendCmd "colormap add $name { $cmap } { $amap }"
2287	}
2288
2289	itcl::body Rappture::VtkSurfaceViewer::SetOrientation { side } {
2290	array set positions {
2291	front "1 0 0 0"
2292	back "0 0 1 0"
2293	left "0.707107 0 -0.707107 0"
2294	right "0.707107 0 0.707107 0"
2295	top "0.707107 -0.707107 0 0"
2296	bottom "0.707107 0.707107 0 0"
2297	}
2298	foreach name { -qw -qx -qy -qz } value $positions($side) {
2299	set _view($name) $value
2300	}
2301	set q [ViewToQuaternion]
2302	$_arcball quaternion $q
2303	SendCmd "camera orient $q"
2304	SendCmd "camera reset"
2305	set _view(-xpan) 0
2306	set _view(-ypan) 0
2307	set _view(-zoom) 1.0
2308	}
2309
2310	itcl::body Rappture::VtkSurfaceViewer::UpdateContourList {} {
2311	if { ![info exists _limits($_curFldName)] } {
2312	return
2313	}
2314	if { $_currentNumContours < 1 } {
2315	set _contourList ""
2316	return
2317	}
2318	foreach { vmin vmax } $_limits($_curFldName) break
2319	set v [blt::vector create \#auto]
2320	$v seq $vmin $vmax [expr $_currentNumContours+2]
2321	$v delete end 0
2322	set _contourList [$v range 0 end]
2323	blt::vector destroy $v
2324	}
2325
2326	itcl::body Rappture::VtkSurfaceViewer::SetCurrentFieldName { dataobj } {
2327	set _first $dataobj
2328	$itk_component(field) choices delete 0 end
2329	$itk_component(fieldmenu) delete 0 end
2330	array unset _fields
2331	set _curFldName ""
2332	foreach cname [$_first components] {
2333	foreach fname [$_first fieldnames $cname] {
2334	if { [info exists _fields($fname)] } {
2335	continue
2336	}
2337	foreach { label units components } \
2338	[$_first fieldinfo $fname] break
2339	$itk_component(field) choices insert end "$fname" "$label"
2340	$itk_component(fieldmenu) add radiobutton -label "$label" \
2341	-value $label -variable [itcl::scope _curFldLabel] \
2342	-selectcolor red \
2343	-activebackground $itk_option(-plotbackground) \
2344	-activeforeground $itk_option(-plotforeground) \
2345	-font "Arial 8" \
2346	-command [itcl::code $this LegendTitleAction save]
2347	set _fields($fname) [list $label $units $components]
2348	if { $_curFldName == "" } {
2349	set _curFldName $fname
2350	set _curFldLabel $label
2351	}
2352	}
2353	}
2354	$itk_component(field) value $_curFldLabel
2355	}

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

Download in other formats: