Context Navigation

source: trunk/gui/scripts/vtkheightmapviewer.tcl @ 3435

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

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

Download in other formats: