Context Navigation

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

Last change on this file since 3054 was 3054, checked in by gah, 12 years ago

File size: 69.5 KB

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

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

Download in other formats: