Context Navigation

source: trunk/gui/scripts/vtksurfaceviewer.tcl @ 5092

Last change on this file since 5092 was 5092, checked in by ldelgass, 9 years ago
Add update in Rebuild to allow initial canvas size to be set. We don't want to do this in the constructor since that can cause an error when the add method is called before the constructor returns.
File size: 77.9 KB

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

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

Download in other formats: