Context Navigation

source: branches/multichoice/gui/scripts/vtkheightmapviewer.tcl @ 6371

Last change on this file since 6371 was 6371, checked in by dkearney, 8 years ago
merging changes from trunk into multichoice branch
File size: 91.6 KB

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

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

Download in other formats: