Context Navigation

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

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

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

Download in other formats: