Context Navigation

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

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

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

Download in other formats: