Context Navigation

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

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

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

Download in other formats: