Context Navigation

source: branches/1.2/gui/scripts/vtkheightmapviewer.tcl @ 3589

Last change on this file since 3589 was 3587, checked in by gah, 11 years ago
let clientinfo be the first command sent. Change wait timeout to 900 milliseconds so that sequences don't trigger them
File size: 86.0 KB

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

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

Download in other formats: