Context Navigation

source: branches/1.3/gui/scripts/vtksurfaceviewer.tcl @ 5348

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

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

Download in other formats: