Context Navigation

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

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

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

Download in other formats: