Context Navigation

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

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

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

Download in other formats: