Context Navigation

source: branches/1.3/gui/scripts/vtkglyphviewer.tcl @ 3844

Last change on this file since 3844 was 3844, checked in by ldelgass, 11 years ago
Sync with trunk. Branch now differs only from trunk by r3722 (branch is version 1.3, trunk is version 1.4)
File size: 81.9 KB

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

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

Download in other formats: