Context Navigation

source: branches/1.3/gui/scripts/vtkheightmapviewer.tcl @ 4069

Last change on this file since 4069 was 3844, checked in by ldelgass, 11 years ago
Sync with trunk. Branch now differs only from trunk by r3722 (branch is version 1.3, trunk is version 1.4)
File size: 86.0 KB

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

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

Download in other formats: