Context Navigation

source: trunk/gui/scripts/vtkglyphviewer.tcl @ 3789

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

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

Download in other formats: