Context Navigation

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

Last change on this file since 3553 was 3553, checked in by ldelgass, 12 years ago
Reassert outline state on every Rebuild in heightmap viewer since 'dataset visible 1' will turn it on regardless of setting (need to fix this in the server).
File size: 85.6 KB

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

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

Download in other formats: