Context Navigation

source: trunk/gui/scripts/vtkviewer.tcl @ 3754

Last change on this file since 3754 was 3709, checked in by ldelgass, 11 years ago
Can't colormap a polydata (yet?)
File size: 86.3 KB

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

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

Download in other formats: