Context Navigation

nanovisviewer.tcl @ 6681

Last change on this file since 6681 was 6681, checked in by ldelgass, 8 years ago
merge rappture trunk to blt4_trunk branch
File size: 76.8 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: nanovisviewer - 3D volume rendering
4	#
5	# This widget performs volume rendering on 3D scalar/vector datasets.
6	# It connects to the Nanovis server running on a rendering farm,
7	# transmits data, and displays the results.
8	# ======================================================================
9	# AUTHOR: Michael McLennan, Purdue University
10	# Copyright (c) 2004-2016 HUBzero Foundation, LLC
11	#
12	# See the file "license.terms" for information on usage and
13	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14	# ======================================================================
15	package require Itk
16	package require BLT
17	package require Img
18
19	option add *NanovisViewer.width 4i widgetDefault
20	option add NanovisViewercursor crosshair widgetDefault
21	option add *NanovisViewer.height 4i widgetDefault
22	option add *NanovisViewer.foreground black widgetDefault
23	option add *NanovisViewer.controlBackground gray widgetDefault
24	option add *NanovisViewer.controlDarkBackground #999999 widgetDefault
25	option add *NanovisViewer.plotBackground black widgetDefault
26	option add *NanovisViewer.plotForeground white widgetDefault
27	option add *NanovisViewer.plotOutline gray widgetDefault
28	option add *NanovisViewer.font \
29	--helvetica-medium-r-normal--12-* widgetDefault
30
31	# must use this name -- plugs into Rappture::resources::load
32	proc NanovisViewer_init_resources {} {
33	Rappture::resources::register \
34	nanovis_server Rappture::NanovisViewer::SetServerList
35	}
36
37	itcl::class Rappture::NanovisViewer {
38	inherit Rappture::VisViewer
39
40	itk_option define -plotforeground plotForeground Foreground ""
41	itk_option define -plotbackground plotBackground Background ""
42	itk_option define -plotoutline plotOutline PlotOutline ""
43
44	constructor { args } {
45	Rappture::VisViewer::constructor
46	} {
47	# defined below
48	}
49	destructor {
50	# defined below
51	}
52	public proc SetServerList { namelist } {
53	Rappture::VisViewer::SetServerList "nanovis" $namelist
54	}
55	public method add {dataobj {settings ""}}
56	public method camera {option args}
57	public method delete {args}
58	public method disconnect {}
59	public method download {option args}
60	public method get {args}
61	public method isconnected {}
62	public method limits { tf }
63	public method overMarker { m x }
64	public method parameters {title args} {
65	# do nothing
66	}
67	public method removeDuplicateMarker { m x }
68	public method scale {args}
69	public method updateTransferFunctions {}
70
71	# The following methods are only used by this class.
72	private method AddIsoMarker { x y }
73	private method AdjustSetting {what {value ""}}
74	private method BuildCameraTab {}
75	private method BuildCutplanesTab {}
76	private method BuildDownloadPopup { widget command }
77	private method BuildViewTab {}
78	private method BuildVolumeTab {}
79	private method ComputeTransferFunction { tf }
80	private method Connect {}
81	private method CurrentDatasets {{what -all}}
82	private method Disconnect {}
83	private method DoResize {}
84	private method DrawLegend { tf }
85	private method EventuallyRedrawLegend { }
86	private method EventuallyResize { w h }
87	private method FixLegend {}
88	private method GetImage { args }
89	private method GetVtkData { args }
90	private method InitSettings { args }
91	private method NameTransferFunction { dataobj comp }
92	private method Pan {option x y}
93	private method PanCamera {}
94	private method ParseLevelsOption { tf levels }
95	private method ParseMarkersOption { tf markers }
96	private method QuaternionToView { q } {
97	foreach { _view(-qw) _view(-qx) _view(-qy) _view(-qz) } $q break
98	}
99	private method Rebuild {}
100	private method ReceiveData { args }
101	private method ReceiveImage { args }
102	private method ReceiveLegend { tf vmin vmax size }
103	private method ResetColormap { color }
104	private method Rotate {option x y}
105	private method SendTransferFunctions {}
106	private method SetOrientation { side }
107	private method Slice {option args}
108	private method SlicerTip {axis}
109	private method ViewToQuaternion {} {
110	return [list $_view(-qw) $_view(-qx) $_view(-qy) $_view(-qz)]
111	}
112	private method Zoom {option}
113
114	private variable _arcball ""
115	private variable _dlist ""; # list of data objects
116	private variable _obj2ovride; # maps dataobj => style override
117	private variable _serverDatasets; # contains all the dataobj-component
118	# to volumes in the server
119	private variable _recvdDatasets; # list of data objs to send to server
120	private variable _dataset2style; # maps dataobj-component to transfunc
121	private variable _style2datasets; # maps tf back to list of
122	# dataobj-components using the tf.
123
124	private variable _reset 1; # Connection to server has been reset.
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 _isomarkers; # array of isosurface level values 0..1
129	# Array of transfer functions in server. If 0 the transfer has been
130	# defined but not loaded. If 1 the transfer function has been named
131	# and loaded.
132	private variable _activeTfs
133	private variable _settings
134	private variable _first ""; # This is the topmost volume.
135	private variable _width 0
136	private variable _height 0
137	private variable _resizePending 0
138	private variable _resizeLegendPending 0
139
140	private common _downloadPopup; # download options from popup
141	private common _hardcopy
142	}
143
144	itk::usual NanovisViewer {
145	keep -background -foreground -cursor -font
146	keep -plotbackground -plotforeground
147	}
148
149	# ----------------------------------------------------------------------
150	# CONSTRUCTOR
151	# ----------------------------------------------------------------------
152	itcl::body Rappture::NanovisViewer::constructor {args} {
153	set _serverType "nanovis"
154
155	#DebugOn
156	EnableWaitDialog 900
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	# Legend event
167	$_dispatcher register !legend
168	$_dispatcher dispatch $this !legend "[itcl::code $this FixLegend]; list"
169
170	# Send transfer functions event
171	$_dispatcher register !send_transfunc
172	$_dispatcher dispatch $this !send_transfunc \
173	"[itcl::code $this SendTransferFunctions]; list"
174
175	#
176	# Populate parser with commands handle incoming requests
177	#
178	$_parser alias image [itcl::code $this ReceiveImage]
179	$_parser alias legend [itcl::code $this ReceiveLegend]
180	$_parser alias data [itcl::code $this ReceiveData]
181
182	# Initialize the view to some default parameters.
183	array set _view {
184	-qw 0.853553
185	-qx -0.353553
186	-qy 0.353553
187	-qz 0.146447
188	-xpan 0
189	-ypan 0
190	-zoom 1.0
191	}
192	set _arcball [blt::arcball create 100 100]
193	$_arcball quaternion [ViewToQuaternion]
194
195	set _limits(vmin) 0.0
196	set _limits(vmax) 1.0
197
198	array set _settings [subst {
199	-axesvisible 1
200	-background black
201	-colormap "BCGYR"
202	-cutplanesvisible 0
203	-gridvisible 0
204	-isosurfaceshading 0
205	-legendvisible 1
206	-light 40
207	-light2side 1
208	-opacity 50
209	-outlinevisible 0
210	-qw $_view(-qw)
211	-qx $_view(-qx)
212	-qy $_view(-qy)
213	-qz $_view(-qz)
214	-thickness 350
215	-volume 1
216	-xcutplaneposition 50
217	-xcutplanevisible 0
218	-xpan $_view(-xpan)
219	-ycutplaneposition 50
220	-ycutplanevisible 0
221	-ypan $_view(-ypan)
222	-zcutplaneposition 50
223	-zcutplanevisible 0
224	-zoom $_view(-zoom)
225	}]
226
227	itk_component add view {
228	label $itk_component(plotarea).view -image $_image(plot) \
229	-highlightthickness 0 -borderwidth 0
230	} {
231	usual
232	ignore -highlightthickness -borderwidth -background
233	}
234	bind $itk_component(view) <Control-F1> [itcl::code $this ToggleConsole]
235
236	set f [$itk_component(main) component controls]
237	itk_component add reset {
238	button $f.reset -borderwidth 1 -padx 1 -pady 1 \
239	-highlightthickness 0 \
240	-image [Rappture::icon reset-view] \
241	-command [itcl::code $this Zoom reset]
242	} {
243	usual
244	ignore -highlightthickness
245	}
246	pack $itk_component(reset) -side top -padx 2 -pady 2
247	Rappture::Tooltip::for $itk_component(reset) \
248	"Reset the view to the default zoom level"
249
250	itk_component add zoomin {
251	button $f.zin -borderwidth 1 -padx 1 -pady 1 \
252	-highlightthickness 0 \
253	-image [Rappture::icon zoom-in] \
254	-command [itcl::code $this Zoom in]
255	} {
256	usual
257	ignore -highlightthickness
258	}
259	pack $itk_component(zoomin) -side top -padx 2 -pady 2
260	Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
261
262	itk_component add zoomout {
263	button $f.zout -borderwidth 1 -padx 1 -pady 1 \
264	-highlightthickness 0 \
265	-image [Rappture::icon zoom-out] \
266	-command [itcl::code $this Zoom out]
267	} {
268	usual
269	ignore -highlightthickness
270	}
271	pack $itk_component(zoomout) -side top -padx 2 -pady 2
272	Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
273
274	itk_component add volume {
275	Rappture::PushButton $f.volume \
276	-onimage [Rappture::icon volume-on] \
277	-offimage [Rappture::icon volume-off] \
278	-variable [itcl::scope _settings(-volume)] \
279	-command [itcl::code $this AdjustSetting -volume]
280	}
281	$itk_component(volume) select
282	Rappture::Tooltip::for $itk_component(volume) \
283	"Toggle the volume cloud on/off"
284	pack $itk_component(volume) -padx 2 -pady 2
285
286	itk_component add cutplane {
287	Rappture::PushButton $f.cutplane \
288	-onimage [Rappture::icon cutbutton] \
289	-offimage [Rappture::icon cutbutton] \
290	-variable [itcl::scope _settings(-cutplanesvisible)] \
291	-command [itcl::code $this AdjustSetting -cutplanesvisible]
292	}
293	Rappture::Tooltip::for $itk_component(cutplane) \
294	"Show/Hide cutplanes"
295	#pack $itk_component(cutplane) -padx 2 -pady 2
296
297	if { [catch {
298	BuildViewTab
299	BuildVolumeTab
300	BuildCutplanesTab
301	BuildCameraTab
302	} errs] != 0 } {
303	global errorInfo
304	puts stderr "errs=$errs errorInfo=$errorInfo"
305	}
306
307	# Legend
308	set _image(legend) [image create photo]
309	itk_component add legend {
310	canvas $itk_component(plotarea).legend -height 50 -highlightthickness 0
311	} {
312	usual
313	ignore -highlightthickness
314	rename -background -plotbackground plotBackground Background
315	}
316	bind $itk_component(legend) <Configure> \
317	[itcl::code $this EventuallyRedrawLegend]
318
319	# Hack around the Tk panewindow. The problem is that the requested
320	# size of the 3d view isn't set until an image is retrieved from
321	# the server. So the panewindow uses the tiny size.
322	set w 10000
323	pack forget $itk_component(view)
324	blt::table $itk_component(plotarea) \
325	0,0 $itk_component(view) -fill both -reqwidth $w \
326	1,0 $itk_component(legend) -fill x
327	blt::table configure $itk_component(plotarea) r1 -resize none
328
329	# Bindings for rotation via mouse
330	bind $itk_component(view) <ButtonPress-1> \
331	[itcl::code $this Rotate click %x %y]
332	bind $itk_component(view) <B1-Motion> \
333	[itcl::code $this Rotate drag %x %y]
334	bind $itk_component(view) <ButtonRelease-1> \
335	[itcl::code $this Rotate release %x %y]
336	bind $itk_component(view) <Configure> \
337	[itcl::code $this EventuallyResize %w %h]
338
339	# Bindings for panning via mouse
340	bind $itk_component(view) <ButtonPress-2> \
341	[itcl::code $this Pan click %x %y]
342	bind $itk_component(view) <B2-Motion> \
343	[itcl::code $this Pan drag %x %y]
344	bind $itk_component(view) <ButtonRelease-2> \
345	[itcl::code $this Pan release %x %y]
346
347	# Bindings for panning via keyboard
348	bind $itk_component(view) <KeyPress-Left> \
349	[itcl::code $this Pan set -10 0]
350	bind $itk_component(view) <KeyPress-Right> \
351	[itcl::code $this Pan set 10 0]
352	bind $itk_component(view) <KeyPress-Up> \
353	[itcl::code $this Pan set 0 -10]
354	bind $itk_component(view) <KeyPress-Down> \
355	[itcl::code $this Pan set 0 10]
356	bind $itk_component(view) <Shift-KeyPress-Left> \
357	[itcl::code $this Pan set -2 0]
358	bind $itk_component(view) <Shift-KeyPress-Right> \
359	[itcl::code $this Pan set 2 0]
360	bind $itk_component(view) <Shift-KeyPress-Up> \
361	[itcl::code $this Pan set 0 -2]
362	bind $itk_component(view) <Shift-KeyPress-Down> \
363	[itcl::code $this Pan set 0 2]
364
365	# Bindings for zoom via keyboard
366	bind $itk_component(view) <KeyPress-Prior> \
367	[itcl::code $this Zoom out]
368	bind $itk_component(view) <KeyPress-Next> \
369	[itcl::code $this Zoom in]
370
371	bind $itk_component(view) <Enter> "focus $itk_component(view)"
372
373	if {[string equal "x11" [tk windowingsystem]]} {
374	# Bindings for zoom via mouse
375	bind $itk_component(view) <4> [itcl::code $this Zoom out]
376	bind $itk_component(view) <5> [itcl::code $this Zoom in]
377	}
378
379	set _image(download) [image create photo]
380
381	eval itk_initialize $args
382	Connect
383	}
384
385	# ----------------------------------------------------------------------
386	# DESTRUCTOR
387	# ----------------------------------------------------------------------
388	itcl::body Rappture::NanovisViewer::destructor {} {
389	$_dispatcher cancel !rebuild
390	$_dispatcher cancel !send_transfunc
391	$_dispatcher cancel !resize
392	image delete $_image(plot)
393	image delete $_image(legend)
394	image delete $_image(download)
395	catch { blt::arcball destroy $_arcball }
396	array unset _settings
397	}
398
399	# ----------------------------------------------------------------------
400	# USAGE: add <dataobj> ?<settings>?
401	#
402	# Clients use this to add a data object to the plot. The optional
403	# <settings> are used to configure the plot. Allowed settings are
404	# -color, -brightness, -width, -linestyle, and -raise.
405	# ----------------------------------------------------------------------
406	itcl::body Rappture::NanovisViewer::add {dataobj {settings ""}} {
407	if { ![$dataobj isvalid] } {
408	return; # Object doesn't contain valid data.
409	}
410	array set params {
411	-color auto
412	-width 1
413	-linestyle solid
414	-brightness 0
415	-raise 0
416	-description ""
417	-param ""
418	}
419	array set params $settings
420
421	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
422	# can't handle -autocolors yet
423	set params(-color) black
424	}
425	set pos [lsearch -exact $_dlist $dataobj]
426	if {$pos < 0} {
427	lappend _dlist $dataobj
428	set _obj2ovride($dataobj-color) $params(-color)
429	set _obj2ovride($dataobj-width) $params(-width)
430	set _obj2ovride($dataobj-raise) $params(-raise)
431	$_dispatcher event -idle !rebuild
432	}
433	}
434
435	# ----------------------------------------------------------------------
436	# USAGE: get ?-objects?
437	# USAGE: get ?-image view\|legend?
438	#
439	# Clients use this to query the list of objects being plotted, in
440	# order from bottom to top of this result. The optional "-image"
441	# flag can also request the internal images being shown.
442	# ----------------------------------------------------------------------
443	itcl::body Rappture::NanovisViewer::get {args} {
444	if {[llength $args] == 0} {
445	set args "-objects"
446	}
447
448	set op [lindex $args 0]
449	switch -- $op {
450	"-objects" {
451	# put the dataobj list in order according to -raise options
452	set dlist $_dlist
453	foreach dataobj $dlist {
454	if {[info exists _obj2ovride($dataobj-raise)] &&
455	$_obj2ovride($dataobj-raise)} {
456	set i [lsearch -exact $dlist $dataobj]
457	if {$i >= 0} {
458	set dlist [lreplace $dlist $i $i]
459	lappend dlist $dataobj
460	}
461	}
462	}
463	return $dlist
464	}
465	"-image" {
466	if {[llength $args] != 2} {
467	error "wrong # args: should be \"get -image view\|legend\""
468	}
469	switch -- [lindex $args end] {
470	view {
471	return $_image(plot)
472	}
473	legend {
474	return $_image(legend)
475	}
476	default {
477	error "bad image name \"[lindex $args end]\": should be view or legend"
478	}
479	}
480	}
481	default {
482	error "bad option \"$op\": should be -objects or -image"
483	}
484	}
485	}
486
487	# ----------------------------------------------------------------------
488	# USAGE: delete ?<dataobj1> <dataobj2> ...?
489	#
490	# Clients use this to delete a dataobj from the plot. If no dataobjs
491	# are specified, then all dataobjs are deleted. No data objects are
492	# deleted. They are only removed from the display list.
493	# ----------------------------------------------------------------------
494	itcl::body Rappture::NanovisViewer::delete {args} {
495	if {[llength $args] == 0} {
496	set args $_dlist
497	}
498	# Delete all specified dataobjs
499	set changed 0
500	foreach dataobj $args {
501	set pos [lsearch -exact $_dlist $dataobj]
502	if { $pos >= 0 } {
503	set _dlist [lreplace $_dlist $pos $pos]
504	array unset _obj2ovride $dataobj-*
505	set changed 1
506	}
507	}
508	# If anything changed, then rebuild the plot
509	if {$changed} {
510	$_dispatcher event -idle !rebuild
511	}
512	}
513
514	# ----------------------------------------------------------------------
515	# USAGE: scale ?<data1> <data2> ...?
516	#
517	# Sets the default limits for the overall plot according to the
518	# limits of the data for all of the given <data> objects. This
519	# accounts for all objects--even those not showing on the screen.
520	# Because of this, the limits are appropriate for all objects as
521	# the user scans through data in the ResultSet viewer.
522	# ----------------------------------------------------------------------
523	itcl::body Rappture::NanovisViewer::scale {args} {
524	foreach val {xmin xmax ymin ymax zmin zmax vmin vmax} {
525	set _limits($val) ""
526	}
527	foreach dataobj $args {
528	if { ![$dataobj isvalid] } {
529	continue; # Object doesn't contain valid data.
530	}
531	foreach axis {x y z v} {
532	foreach { min max } [$dataobj limits $axis] break
533	if {"" != $min && "" != $max} {
534	if {"" == $_limits(${axis}min)} {
535	set _limits(${axis}min) $min
536	set _limits(${axis}max) $max
537	} else {
538	if {$min < $_limits(${axis}min)} {
539	set _limits(${axis}min) $min
540	}
541	if {$max > $_limits(${axis}max)} {
542	set _limits(${axis}max) $max
543	}
544	}
545	}
546	}
547	}
548	}
549
550	# ----------------------------------------------------------------------
551	# USAGE: download coming
552	# USAGE: download controls <downloadCommand>
553	# USAGE: download now
554	#
555	# Clients use this method to create a downloadable representation
556	# of the plot. Returns a list of the form {ext string}, where
557	# "ext" is the file extension (indicating the type of data) and
558	# "string" is the data itself.
559	# ----------------------------------------------------------------------
560	itcl::body Rappture::NanovisViewer::download {option args} {
561	switch $option {
562	coming {
563	if {[catch {
564	blt::winop snap $itk_component(plotarea) $_image(download)
565	}]} {
566	$_image(download) configure -width 1 -height 1
567	$_image(download) put #000000
568	}
569	}
570	controls {
571	set popup .nanovisviewerdownload
572	if { ![winfo exists $popup] } {
573	set inner [BuildDownloadPopup $popup [lindex $args 0]]
574	} else {
575	set inner [$popup component inner]
576	}
577	# FIXME: we only support download of current active component
578	#set num [llength [get]]
579	#set num [expr {($num == 1) ? "1 result" : "$num results"}]
580	set num "current field component"
581	set word [Rappture::filexfer::label downloadWord]
582	$inner.summary configure -text "$word $num in the following format:"
583	update idletasks ;# Fix initial sizes
584	return $popup
585	}
586	now {
587	set popup .nanovisviewerdownload
588	if { [winfo exists $popup] } {
589	$popup deactivate
590	}
591	switch -- $_downloadPopup(format) {
592	"image" {
593	return [$this GetImage [lindex $args 0]]
594	}
595	"vtk" {
596	return [$this GetVtkData [lindex $args 0]]
597	}
598	default {
599	error "bad download format \"$_downloadPopup(format)\""
600	}
601	}
602	}
603	default {
604	error "bad option \"$option\": should be coming, controls, now"
605	}
606	}
607	}
608
609	# ----------------------------------------------------------------------
610	# USAGE: Connect ?<host:port>,<host:port>...?
611	#
612	# Clients use this method to establish a connection to a new
613	# server, or to reestablish a connection to the previous server.
614	# Any existing connection is automatically closed.
615	# ----------------------------------------------------------------------
616	itcl::body Rappture::NanovisViewer::Connect {} {
617	set _hosts [GetServerList "nanovis"]
618	if { "" == $_hosts } {
619	return 0
620	}
621	set _reset 1
622	set result [VisViewer::Connect $_hosts]
623	if { $result } {
624	if { $_reportClientInfo } {
625	# Tell the server the viewer, hub, user and session.
626	# Do this immediately on connect before buffering any commands
627	global env
628
629	set info {}
630	set user "???"
631	if { [info exists env(USER)] } {
632	set user $env(USER)
633	}
634	set session "???"
635	if { [info exists env(SESSION)] } {
636	set session $env(SESSION)
637	}
638	lappend info "version" "$Rappture::version"
639	lappend info "build" "$Rappture::build"
640	lappend info "svnurl" "$Rappture::svnurl"
641	lappend info "installdir" "$Rappture::installdir"
642	lappend info "hub" [exec hostname]
643	lappend info "client" "nanovisviewer"
644	lappend info "user" $user
645	lappend info "session" $session
646	SendCmd "clientinfo [list $info]"
647	}
648
649	set w [winfo width $itk_component(view)]
650	set h [winfo height $itk_component(view)]
651	EventuallyResize $w $h
652	}
653	return $result
654	}
655
656	#
657	# isconnected --
658	#
659	# Indicates if we are currently connected to the visualization server.
660	#
661	itcl::body Rappture::NanovisViewer::isconnected {} {
662	return [VisViewer::IsConnected]
663	}
664
665	#
666	# disconnect --
667	#
668	itcl::body Rappture::NanovisViewer::disconnect {} {
669	Disconnect
670	}
671
672	#
673	# Disconnect --
674	#
675	# Clients use this method to disconnect from the current rendering server.
676	#
677	itcl::body Rappture::NanovisViewer::Disconnect {} {
678	VisViewer::Disconnect
679
680	# disconnected -- no more data sitting on server
681	array unset _serverDatasets
682	}
683
684	# ----------------------------------------------------------------------
685	# USAGE: SendTransferFunctions
686	# ----------------------------------------------------------------------
687	itcl::body Rappture::NanovisViewer::SendTransferFunctions {} {
688	if { $_first == "" } {
689	puts stderr "first not set"
690	return
691	}
692	# Ensure that the global thickness setting (in the slider
693	# settings widget) is used for the active transfer-function. Update
694	# the value in the _settings variable.
695	# Scale values between 0.00001 and 0.01000
696	set thickness [expr {double($_settings(-thickness)) * 0.0001}]
697
698	foreach tag [CurrentDatasets] {
699	if { ![info exists _serverDatasets($tag)] \|\| !$_serverDatasets($tag) } {
700	# The volume hasn't reached the server yet. How did we get
701	# here?
702	puts stderr "Don't have $tag in _serverDatasets"
703	continue
704	}
705	if { ![info exists _dataset2style($tag)] } {
706	puts stderr "don't have style for volume $tag"
707	continue; # How does this happen?
708	}
709	set tf $_dataset2style($tag)
710	set _settings($tf-thickness) $thickness
711	ComputeTransferFunction $tf
712	# FIXME: Need to the send information as to what transfer functions
713	# to update so that we only update the transfer function
714	# as necessary. Right now, all transfer functions are
715	# updated. This makes moving the isomarker slider chunky.
716	if { ![info exists _activeTfs($tf)] \|\| !$_activeTfs($tf) } {
717	set _activeTfs($tf) 1
718	}
719	SendCmd "volume shading transfunc $tf $tag"
720	}
721	FixLegend
722	}
723
724	# ----------------------------------------------------------------------
725	# USAGE: ReceiveImage -bytes <size> -type <type> -token <token>
726	#
727	# Invoked automatically whenever the "image" command comes in from
728	# the rendering server. Indicates that binary image data with the
729	# specified <size> will follow.
730	# ----------------------------------------------------------------------
731	itcl::body Rappture::NanovisViewer::ReceiveImage { args } {
732	array set info {
733	-token "???"
734	-bytes 0
735	-type image
736	}
737	array set info $args
738	set bytes [ReceiveBytes $info(-bytes)]
739	switch -- $info(-type) {
740	"image" {
741	#puts stderr "received image [image width $_image(plot)]x[image height $_image(plot)]"
742	$_image(plot) configure -data $bytes
743	}
744	"print" {
745	set tag $this-print-$info(-token)
746	set _hardcopy($tag) $bytes
747	}
748	default {
749	puts stderr "unknown image type $info(-type)"
750	}
751	}
752	}
753
754	#
755	# DrawLegend --
756	#
757	itcl::body Rappture::NanovisViewer::DrawLegend { tf } {
758	set c $itk_component(legend)
759	set w [winfo width $c]
760	set h [winfo height $c]
761	set lx 10
762	set ly [expr {$h - 1}]
763	if {"" == [$c find withtag colorbar]} {
764	$c create image 10 10 -anchor nw \
765	-image $_image(legend) -tags colorbar
766	$c create text $lx $ly -anchor sw \
767	-fill $itk_option(-plotforeground) -tags "limits text vmin"
768	$c create text [expr {$w-$lx}] $ly -anchor se \
769	-fill $itk_option(-plotforeground) -tags "limits text vmax"
770	$c create text [expr {$w/2}] $ly -anchor s \
771	-fill $itk_option(-plotforeground) -tags "title text"
772	$c lower colorbar
773	$c bind colorbar <ButtonRelease-1> [itcl::code $this AddIsoMarker %x %y]
774	}
775
776	# Display the markers used by the current transfer function.
777	array set limits [limits $tf]
778	$c itemconfigure vmin -text [format %g $limits(min)]
779	$c coords vmin $lx $ly
780
781	$c itemconfigure vmax -text [format %g $limits(max)]
782	$c coords vmax [expr {$w-$lx}] $ly
783
784	if { $_first == "" } {
785	return
786	}
787	set title [$_first hints label]
788	set units [$_first hints units]
789	if { $units != "" } {
790	set title "$title ($units)"
791	}
792	$c itemconfigure title -text $title
793	$c coords title [expr {$w/2}] $ly
794
795	if { [info exists _isomarkers($tf)] } {
796	# The "visible" isomarker method below implicitly calls "absval".
797	# It uses the screen position of the marker to compute the absolute
798	# value. So make sure the window size has been computed before
799	# calling "visible".
800	update idletasks
801	update
802	foreach m $_isomarkers($tf) {
803	$m visible yes
804	}
805	}
806
807	# The colormap may have changed. Resync the slicers with the colormap.
808	set datasets [CurrentDatasets -cutplanes]
809	SendCmd "volume data state $_settings(-volume) $datasets"
810
811	# Adjust the cutplane for only the first component in the topmost volume
812	# (i.e. the first volume designated in the field).
813	set tag [lindex $datasets 0]
814	foreach axis {x y z} {
815	# Turn off cutplanes for all volumes
816	SendCmd "cutplane state 0 $axis"
817	if { $_settings(-${axis}cutplanevisible) } {
818	# Turn on cutplane for this particular volume and set the position
819	SendCmd "cutplane state 1 $axis $tag"
820	set pos [expr {0.01*$_settings(-${axis}cutplaneposition)}]
821	SendCmd "cutplane position $pos $axis $tag"
822	}
823	}
824	}
825
826	#
827	# ReceiveLegend --
828	#
829	# The procedure is the response from the render server to each "legend"
830	# command. The server sends back a "legend" command invoked our
831	# the slave interpreter. The purpose is to collect data of the image
832	# representing the legend in the canvas. In addition, the
833	# active transfer function is displayed.
834	#
835	itcl::body Rappture::NanovisViewer::ReceiveLegend { tf vmin vmax size } {
836	if { ![isconnected] } {
837	return
838	}
839	set bytes [ReceiveBytes $size]
840	$_image(legend) configure -data $bytes
841	ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
842
843	DrawLegend $tf
844	}
845
846	#
847	# ReceiveData --
848	#
849	# The procedure is the response from the render server to each "data
850	# follows" command. The server sends back a "data" command invoked our
851	# the slave interpreter. The purpose is to collect the min/max of the
852	# volume sent to the render server. Since the client (nanovisviewer)
853	# doesn't parse 3D data formats, we rely on the server (nanovis) to
854	# tell us what the limits are. Once we've received the limits to all
855	# the data we've sent (tracked by _recvdDatasets) we can then determine
856	# what the transfer functions are for these volumes.
857	#
858	#
859	# Note: There is a considerable tradeoff in having the server report
860	# back what the data limits are. It means that much of the code
861	# having to do with transfer-functions has to wait for the data
862	# to come back, since the isomarkers are calculated based upon
863	# the data limits. The client code is much messier because of
864	# this. The alternative is to parse any of the 3D formats on the
865	# client side.
866	#
867	itcl::body Rappture::NanovisViewer::ReceiveData { args } {
868	if { ![isconnected] } {
869	return
870	}
871
872	# Arguments from server are name value pairs. Stuff them in an array.
873	array set info $args
874
875	set tag $info(tag)
876	set parts [split $tag -]
877
878	#
879	# Volumes don't exist until we're told about them.
880	#
881	set dataobj [lindex $parts 0]
882	set _serverDatasets($tag) 1
883	if { $_settings(-volume) && $dataobj == $_first } {
884	SendCmd "volume state 1 $tag"
885	}
886	set _limits($tag-min) $info(min); # Minimum value of the volume.
887	set _limits($tag-max) $info(max); # Maximum value of the volume.
888	set _limits(vmin) $info(vmin); # Overall minimum value.
889	set _limits(vmax) $info(vmax); # Overall maximum value.
890
891	unset _recvdDatasets($tag)
892	if { [array size _recvdDatasets] == 0 } {
893	# The active transfer function is by default the first component of
894	# the first data object. This assumes that the data is always
895	# successfully transferred.
896	updateTransferFunctions
897	}
898	}
899
900	# ----------------------------------------------------------------------
901	# USAGE: Rebuild
902	#
903	# Called automatically whenever something changes that affects the
904	# data in the widget. Clears any existing data and rebuilds the
905	# widget to display new data.
906	# ----------------------------------------------------------------------
907	itcl::body Rappture::NanovisViewer::Rebuild {} {
908	set w [winfo width $itk_component(view)]
909	set h [winfo height $itk_component(view)]
910	if { $w < 2 \|\| $h < 2 } {
911	update
912	$_dispatcher event -idle !rebuild
913	return
914	}
915
916	# Turn on buffering of commands to the server. We don't want to
917	# be preempted by a server disconnect/reconnect (which automatically
918	# generates a new call to Rebuild).
919	StartBufferingCommands
920
921	# Hide all the isomarkers. Can't remove them. Have to remember the
922	# settings since the user may have created/deleted/moved markers.
923
924	# The "visible" isomarker method below implicitly calls "absval". It
925	# uses the screen position of the marker to compute the absolute value.
926	# So make sure the window size has been computed before calling
927	# "visible".
928	update idletasks
929	update
930	foreach tf [array names _isomarkers] {
931	foreach m $_isomarkers($tf) {
932	$m visible no
933	}
934	}
935
936	if { $_width != $w \|\| $_height != $h \|\| $_reset } {
937	set _width $w
938	set _height $h
939	$_arcball resize $w $h
940	DoResize
941	}
942	if { $_reset } {
943	InitSettings -background -axesvisible -gridvisible
944	}
945	foreach dataobj [get] {
946	foreach cname [$dataobj components] {
947	set tag $dataobj-$cname
948	if { ![info exists _serverDatasets($tag)] } {
949	# Send the data as one huge base64-encoded mess -- yuck!
950	if { [$dataobj type] == "dx" } {
951	set data [$dataobj blob $cname]
952	} else {
953	set data [$dataobj vtkdata $cname]
954	if 0 {
955	set f [open "/tmp/volume.vtk" "w"]
956	fconfigure $f -translation binary -encoding binary
957	puts -nonewline $f $data
958	close $f
959	}
960	}
961	set nbytes [string length $data]
962	if { $_reportClientInfo } {
963	set info {}
964	lappend info "tool_id" [$dataobj hints toolid]
965	lappend info "tool_name" [$dataobj hints toolname]
966	lappend info "tool_title" [$dataobj hints tooltitle]
967	lappend info "tool_command" [$dataobj hints toolcommand]
968	lappend info "tool_revision" [$dataobj hints toolrevision]
969	lappend info "dataset_label" [$dataobj hints label]
970	lappend info "dataset_size" $nbytes
971	lappend info "dataset_tag" $tag
972	SendCmd "clientinfo [list $info]"
973	}
974	SendCmd "volume data follows $nbytes $tag"
975	SendData $data
976	set _recvdDatasets($tag) 1
977	set _serverDatasets($tag) 0
978	}
979	NameTransferFunction $dataobj $cname
980	}
981	}
982	set _first [lindex [get] 0]
983	# Outline seems to need to be reset every update.
984	InitSettings -outlinevisible ;#-cutplanesvisible
985	if { $_reset } {
986	#
987	# Reset the camera and other view parameters
988	#
989	set _settings(-qw) $_view(-qw)
990	set _settings(-qx) $_view(-qx)
991	set _settings(-qy) $_view(-qy)
992	set _settings(-qz) $_view(-qz)
993	set _settings(-xpan) $_view(-xpan)
994	set _settings(-ypan) $_view(-ypan)
995	set _settings(-zoom) $_view(-zoom)
996
997	set q [ViewToQuaternion]
998	$_arcball quaternion $q
999	SendCmd "camera orient $q"
1000	SendCmd "camera reset"
1001	PanCamera
1002	SendCmd "camera zoom $_view(-zoom)"
1003
1004	# Turn off cutplanes for all volumes
1005	foreach axis {x y z} {
1006	SendCmd "cutplane state 0 $axis"
1007	}
1008
1009	InitSettings -opacity -light2side -isosurfaceshading \
1010	-light \
1011	-xcutplanevisible -ycutplanevisible -zcutplanevisible
1012
1013	if {"" != $_first} {
1014	set axis [$_first hints updir]
1015	if { "" != $axis } {
1016	SendCmd "up $axis"
1017	}
1018	set location [$_first hints camera]
1019	if { $location != "" } {
1020	array set _view $location
1021	}
1022	}
1023	set _reset 0
1024	}
1025
1026	# nothing to send -- activate the proper ivol
1027	SendCmd "volume state 0"
1028	if {"" != $_first} {
1029	set datasets [array names _serverDatasets $_first-*]
1030	if { $datasets != "" } {
1031	SendCmd "volume state 1 $datasets"
1032	}
1033	# If the first volume already exists on the server, then make sure
1034	# we display the proper transfer function in the legend.
1035	set cname [lindex [$_first components] 0]
1036	if { [info exists _serverDatasets($_first-$cname)] } {
1037	updateTransferFunctions
1038	}
1039	}
1040	# Actually write the commands to the server socket. If it fails, we don't
1041	# care. We're finished here.
1042	blt::busy hold $itk_component(hull)
1043	StopBufferingCommands
1044	blt::busy release $itk_component(hull)
1045	}
1046
1047	# ----------------------------------------------------------------------
1048	# USAGE: CurrentDatasets ?-cutplanes?
1049	#
1050	# Returns a list of volume server IDs for the current volume being
1051	# displayed. This is normally a single ID, but it might be a list
1052	# of IDs if the current data object has multiple components.
1053	# ----------------------------------------------------------------------
1054	itcl::body Rappture::NanovisViewer::CurrentDatasets {{what -all}} {
1055	set rlist ""
1056	if { $_first == "" } {
1057	return
1058	}
1059	foreach cname [$_first components] {
1060	set tag $_first-$cname
1061	if { [info exists _serverDatasets($tag)] && $_serverDatasets($tag) } {
1062	array set style {
1063	-cutplanes 1
1064	}
1065	array set style [lindex [$_first components -style $cname] 0]
1066	if { $what != "-cutplanes" \|\| $style(-cutplanes) } {
1067	lappend rlist $tag
1068	}
1069	}
1070	}
1071	return $rlist
1072	}
1073
1074	# ----------------------------------------------------------------------
1075	# USAGE: Zoom in
1076	# USAGE: Zoom out
1077	# USAGE: Zoom reset
1078	#
1079	# Called automatically when the user clicks on one of the zoom
1080	# controls for this widget. Changes the zoom for the current view.
1081	# ----------------------------------------------------------------------
1082	itcl::body Rappture::NanovisViewer::Zoom {option} {
1083	switch -- $option {
1084	"in" {
1085	set _view(-zoom) [expr {$_view(-zoom)*1.25}]
1086	set _settings(-zoom) $_view(-zoom)
1087	SendCmd "camera zoom $_view(-zoom)"
1088	}
1089	"out" {
1090	set _view(-zoom) [expr {$_view(-zoom)*0.8}]
1091	set _settings(-zoom) $_view(-zoom)
1092	SendCmd "camera zoom $_view(-zoom)"
1093	}
1094	"reset" {
1095	array set _view {
1096	-qw 0.853553
1097	-qx -0.353553
1098	-qy 0.353553
1099	-qz 0.146447
1100	-xpan 0
1101	-ypan 0
1102	-zoom 1.0
1103	}
1104	if { $_first != "" } {
1105	set location [$_first hints camera]
1106	if { $location != "" } {
1107	array set _view $location
1108	}
1109	}
1110	set q [ViewToQuaternion]
1111	$_arcball quaternion $q
1112	SendCmd "camera orient $q"
1113	SendCmd "camera reset"
1114	set _settings(-qw) $_view(-qw)
1115	set _settings(-qx) $_view(-qx)
1116	set _settings(-qy) $_view(-qy)
1117	set _settings(-qz) $_view(-qz)
1118	set _settings(-xpan) $_view(-xpan)
1119	set _settings(-ypan) $_view(-ypan)
1120	set _settings(-zoom) $_view(-zoom)
1121	}
1122	}
1123	}
1124
1125	itcl::body Rappture::NanovisViewer::PanCamera {} {
1126	set x $_view(-xpan)
1127	set y $_view(-ypan)
1128	SendCmd "camera pan $x $y"
1129	}
1130
1131	# ----------------------------------------------------------------------
1132	# USAGE: Rotate click <x> <y>
1133	# USAGE: Rotate drag <x> <y>
1134	# USAGE: Rotate release <x> <y>
1135	#
1136	# Called automatically when the user clicks/drags/releases in the
1137	# plot area. Moves the plot according to the user's actions.
1138	# ----------------------------------------------------------------------
1139	itcl::body Rappture::NanovisViewer::Rotate {option x y} {
1140	switch -- $option {
1141	click {
1142	$itk_component(view) configure -cursor fleur
1143	set _click(x) $x
1144	set _click(y) $y
1145	}
1146	drag {
1147	if {[array size _click] == 0} {
1148	Rotate click $x $y
1149	} else {
1150	set w [winfo width $itk_component(view)]
1151	set h [winfo height $itk_component(view)]
1152	if {$w <= 0 \|\| $h <= 0} {
1153	return
1154	}
1155
1156	if {[catch {
1157	# this fails sometimes for no apparent reason
1158	set dx [expr {double($x-$_click(x))/$w}]
1159	set dy [expr {double($y-$_click(y))/$h}]
1160	}]} {
1161	return
1162	}
1163
1164	set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1165	QuaternionToView $q
1166	set _settings(-qw) $_view(-qw)
1167	set _settings(-qx) $_view(-qx)
1168	set _settings(-qy) $_view(-qy)
1169	set _settings(-qz) $_view(-qz)
1170	SendCmd "camera orient $q"
1171
1172	set _click(x) $x
1173	set _click(y) $y
1174	}
1175	}
1176	release {
1177	Rotate drag $x $y
1178	$itk_component(view) configure -cursor ""
1179	catch {unset _click}
1180	}
1181	default {
1182	error "bad option \"$option\": should be click, drag, release"
1183	}
1184	}
1185	}
1186
1187	# ----------------------------------------------------------------------
1188	# USAGE: $this Pan click x y
1189	# $this Pan drag x y
1190	# $this Pan release x y
1191	#
1192	# Called automatically when the user clicks on one of the zoom
1193	# controls for this widget. Changes the zoom for the current view.
1194	# ----------------------------------------------------------------------
1195	itcl::body Rappture::NanovisViewer::Pan {option x y} {
1196	# Experimental stuff
1197	set w [winfo width $itk_component(view)]
1198	set h [winfo height $itk_component(view)]
1199	if { $option == "set" } {
1200	set x [expr $x / double($w)]
1201	set y [expr $y / double($h)]
1202	set _view(-xpan) [expr $_view(-xpan) + $x]
1203	set _view(-ypan) [expr $_view(-ypan) + $y]
1204	PanCamera
1205	set _settings(-xpan) $_view(-xpan)
1206	set _settings(-ypan) $_view(-ypan)
1207	return
1208	}
1209	if { $option == "click" } {
1210	set _click(x) $x
1211	set _click(y) $y
1212	$itk_component(view) configure -cursor hand1
1213	}
1214	if { $option == "drag" \|\| $option == "release" } {
1215	set dx [expr ($_click(x) - $x)/double($w)]
1216	set dy [expr ($_click(y) - $y)/double($h)]
1217	set _click(x) $x
1218	set _click(y) $y
1219	set _view(-xpan) [expr $_view(-xpan) - $dx]
1220	set _view(-ypan) [expr $_view(-ypan) - $dy]
1221	PanCamera
1222	set _settings(-xpan) $_view(-xpan)
1223	set _settings(-ypan) $_view(-ypan)
1224	}
1225	if { $option == "release" } {
1226	$itk_component(view) configure -cursor ""
1227	}
1228	}
1229
1230	# ----------------------------------------------------------------------
1231	# USAGE: InitSettings <what> ?<value>?
1232	#
1233	# Used internally to update rendering settings whenever parameters
1234	# change in the popup settings panel. Sends the new settings off
1235	# to the back end.
1236	# ----------------------------------------------------------------------
1237	itcl::body Rappture::NanovisViewer::InitSettings { args } {
1238	foreach arg $args {
1239	AdjustSetting $arg
1240	}
1241	}
1242
1243	# ----------------------------------------------------------------------
1244	# USAGE: AdjustSetting <what> ?<value>?
1245	#
1246	# Used internally to update rendering settings whenever parameters
1247	# change in the popup settings panel. Sends the new settings off
1248	# to the back end.
1249	# ----------------------------------------------------------------------
1250	itcl::body Rappture::NanovisViewer::AdjustSetting {what {value ""}} {
1251	if {![isconnected]} {
1252	return
1253	}
1254	switch -- $what {
1255	"-axesvisible" {
1256	SendCmd "axis visible $_settings($what)"
1257	}
1258	"-background" {
1259	set bgcolor [$itk_component(background) value]
1260	array set fgcolors {
1261	"black" "white"
1262	"white" "black"
1263	"grey" "black"
1264	}
1265	configure -plotbackground $bgcolor \
1266	-plotforeground $fgcolors($bgcolor)
1267	#DrawLegend $_current
1268	}
1269	"-colormap" {
1270	set color [$itk_component(colormap) value]
1271	set _settings($what) $color
1272	# Only set the colormap on the first volume. Ignore the others.
1273	#ResetColormap $color
1274	}
1275	"-cutplanesvisible" {
1276	set bool $_settings($what)
1277	# We only set cutplanes on the first dataset.
1278	set datasets [CurrentDatasets -cutplanes]
1279	set tag [lindex $datasets 0]
1280	SendCmd "cutplane visible $bool $tag"
1281	}
1282	"-gridvisible" {
1283	SendCmd "grid visible $_settings($what)"
1284	}
1285	"-isosurfaceshading" {
1286	set val $_settings($what)
1287	SendCmd "volume shading isosurface $val"
1288	}
1289	"-legendvisible" {
1290	if { $_settings($what) } {
1291	blt::table $itk_component(plotarea) \
1292	0,0 $itk_component(view) -fill both \
1293	1,0 $itk_component(legend) -fill x
1294	blt::table configure $itk_component(plotarea) r1 -resize none
1295	} else {
1296	blt::table forget $itk_component(legend)
1297	}
1298	}
1299	"-light" {
1300	set val $_settings($what)
1301	set diffuse [expr {0.01*$val}]
1302	set ambient [expr {1.0-$diffuse}]
1303	set specularLevel 0.3
1304	set specularExp 90.0
1305	SendCmd "volume shading ambient $ambient"
1306	SendCmd "volume shading diffuse $diffuse"
1307	SendCmd "volume shading specularLevel $specularLevel"
1308	SendCmd "volume shading specularExp $specularExp"
1309	}
1310	"-light2side" {
1311	set val $_settings($what)
1312	SendCmd "volume shading light2side $val"
1313	}
1314	"-opacity" {
1315	set val $_settings($what)
1316	set sval [expr { 0.01 * double($val) }]
1317	SendCmd "volume shading opacity $sval"
1318	}
1319	"-outlinevisible" {
1320	SendCmd "volume outline state $_settings($what)"
1321	}
1322	"-thickness" {
1323	if { [array names _activeTfs] > 0 } {
1324	set val $_settings($what)
1325	# Scale values between 0.00001 and 0.01000
1326	set sval [expr {0.0001*double($val)}]
1327	foreach tf [array names _activeTfs] {
1328	set _settings($tf${what}) $sval
1329	set _activeTfs($tf) 0
1330	}
1331	updateTransferFunctions
1332	}
1333	}
1334	"-volume" {
1335	set datasets [CurrentDatasets -cutplanes]
1336	SendCmd "volume data state $_settings($what) $datasets"
1337	}
1338	"-xcutplaneposition" - "-ycutplaneposition" - "-zcutplaneposition" {
1339	set axis [string range $what 1 1]
1340	set pos [expr $_settings($what) * 0.01]
1341	# We only set cutplanes on the first dataset.
1342	set datasets [CurrentDatasets -cutplanes]
1343	set tag [lindex $datasets 0]
1344	SendCmd "cutplane position $pos $axis $tag"
1345	}
1346	"-xcutplanevisible" - "-ycutplanevisible" - "-zcutplanevisible" {
1347	set axis [string range $what 1 1]
1348	set bool $_settings($what)
1349	# We only set cutplanes on the first dataset.
1350	set datasets [CurrentDatasets -cutplanes]
1351	set tag [lindex $datasets 0]
1352	SendCmd "cutplane state $bool $axis $tag"
1353	if { $bool } {
1354	$itk_component(${axis}CutScale) configure -state normal \
1355	-troughcolor white
1356	} else {
1357	$itk_component(${axis}CutScale) configure -state disabled \
1358	-troughcolor grey82
1359	}
1360	}
1361	default {
1362	error "don't know how to fix $what"
1363	}
1364	}
1365	}
1366
1367	# ----------------------------------------------------------------------
1368	# USAGE: FixLegend
1369	#
1370	# Used internally to update the legend area whenever it changes size
1371	# or when the field changes. Asks the server to send a new legend
1372	# for the current field.
1373	# ----------------------------------------------------------------------
1374	itcl::body Rappture::NanovisViewer::FixLegend {} {
1375	set _resizeLegendPending 0
1376	set lineht [font metrics $itk_option(-font) -linespace]
1377	set w [expr {$_width-20}]
1378	set h [expr {[winfo height $itk_component(legend)]-20-$lineht}]
1379	if {$w > 0 && $h > 0 && [array names _activeTfs] > 0 && $_first != "" } {
1380	set tag [lindex [CurrentDatasets] 0]
1381	if { [info exists _dataset2style($tag)] } {
1382	SendCmd "legend $_dataset2style($tag) $w $h"
1383	}
1384	}
1385	}
1386
1387	#
1388	# NameTransferFunction --
1389	#
1390	# Creates a transfer function name based on the <style> settings in the
1391	# library run.xml file. This placeholder will be used later to create
1392	# and send the actual transfer function once the data info has been sent
1393	# to us by the render server. [We won't know the volume limits until the
1394	# server parses the 3D data and sends back the limits via ReceiveData.]
1395	#
1396	# FIXME: The current way we generate transfer-function names completely
1397	# ignores the -markers option. The problem is that we are forced
1398	# to compute the name from an increasing complex set of values:
1399	# color, levels, markers.
1400	#
1401	itcl::body Rappture::NanovisViewer::NameTransferFunction { dataobj cname } {
1402	array set style {
1403	-color BCGYR
1404	-levels 6
1405	}
1406	set tag $dataobj-$cname
1407	array set style [lindex [$dataobj components -style $cname] 0]
1408	set tf "$style(-color):$style(-levels)"
1409	set _dataset2style($tag) $tf
1410	lappend _style2datasets($tf) $tag
1411	return $tf
1412	}
1413
1414	#
1415	# ComputeTransferFunction --
1416	#
1417	# Computes and sends the transfer function to the render server. It's
1418	# assumed that the volume data limits are known and that the global
1419	# transfer-functions slider values have been set up. Both parts are
1420	# needed to compute the relative value (location) of the marker, and
1421	# the alpha map of the transfer function.
1422	#
1423	itcl::body Rappture::NanovisViewer::ComputeTransferFunction { tf } {
1424	array set style {
1425	-color BCGYR
1426	-levels 6
1427	}
1428
1429	foreach {dataobj cname} [split [lindex $_style2datasets($tf) 0] -] break
1430	array set style [lindex [$dataobj components -style $cname] 0]
1431
1432	# We have to parse the style attributes for a volume using this
1433	# transfer-function once. This sets up the initial isomarkers for the
1434	# transfer function. The user may add/delete markers, so we have to
1435	# maintain a list of markers for each transfer-function. We use the one
1436	# of the volumes (the first in the list) using the transfer-function as a
1437	# reference.
1438	#
1439	# FIXME: The current way we generate transfer-function names completely
1440	# ignores the -markers option. The problem is that we are forced
1441	# to compute the name from an increasing complex set of values:
1442	# color, levels, markers.
1443	if { ![info exists _isomarkers($tf)] } {
1444	# Have to defer creation of isomarkers until we have data limits
1445	if { [info exists style(-markers)] &&
1446	[llength $style(-markers)] > 0 } {
1447	ParseMarkersOption $tf $style(-markers)
1448	} else {
1449	ParseLevelsOption $tf $style(-levels)
1450	}
1451	}
1452	set cmap [ColorsToColormap $style(-color)]
1453
1454	# Transfer function should be normalized with [0,1] range
1455	# The volume shading opacity setting is used to scale opacity
1456	# in the volume shader.
1457	set max 1.0
1458
1459	set isovalues {}
1460	foreach m $_isomarkers($tf) {
1461	lappend isovalues [$m relval]
1462	}
1463	# Sort the isovalues
1464	set isovalues [lsort -real $isovalues]
1465
1466	if { ![info exists _settings($tf-thickness)]} {
1467	set _settings($tf-thickness) 0.005
1468	}
1469	set delta $_settings($tf-thickness)
1470
1471	set first [lindex $isovalues 0]
1472	set last [lindex $isovalues end]
1473	set amap ""
1474	if { $first == "" \|\| $first != 0.0 } {
1475	lappend amap 0.0 0.0
1476	}
1477	foreach x $isovalues {
1478	set x1 [expr {$x-$delta-0.00001}]
1479	set x2 [expr {$x-$delta}]
1480	set x3 [expr {$x+$delta}]
1481	set x4 [expr {$x+$delta+0.00001}]
1482	if { $x1 < 0.0 } {
1483	set x1 0.0
1484	} elseif { $x1 > 1.0 } {
1485	set x1 1.0
1486	}
1487	if { $x2 < 0.0 } {
1488	set x2 0.0
1489	} elseif { $x2 > 1.0 } {
1490	set x2 1.0
1491	}
1492	if { $x3 < 0.0 } {
1493	set x3 0.0
1494	} elseif { $x3 > 1.0 } {
1495	set x3 1.0
1496	}
1497	if { $x4 < 0.0 } {
1498	set x4 0.0
1499	} elseif { $x4 > 1.0 } {
1500	set x4 1.0
1501	}
1502	# add spikes in the middle
1503	lappend amap $x1 0.0
1504	lappend amap $x2 $max
1505	lappend amap $x3 $max
1506	lappend amap $x4 0.0
1507	}
1508	if { $last == "" \|\| $last != 1.0 } {
1509	lappend amap 1.0 0.0
1510	}
1511	SendCmd "transfunc define $tf { $cmap } { $amap }"
1512	}
1513
1514	# ----------------------------------------------------------------------
1515	# CONFIGURATION OPTION: -plotbackground
1516	# ----------------------------------------------------------------------
1517	itcl::configbody Rappture::NanovisViewer::plotbackground {
1518	if { [isconnected] } {
1519	set color $itk_option(-plotbackground)
1520	set rgb [Color2RGB $color]
1521	SendCmd "screen bgcolor $rgb"
1522	$itk_component(legend) configure -background $color
1523	}
1524	}
1525
1526	# ----------------------------------------------------------------------
1527	# CONFIGURATION OPTION: -plotforeground
1528	# ----------------------------------------------------------------------
1529	itcl::configbody Rappture::NanovisViewer::plotforeground {
1530	if { [isconnected] } {
1531	set color $itk_option(-plotforeground)
1532	set rgb [Color2RGB $color]
1533	SendCmd "volume outline color $rgb"
1534	SendCmd "grid axiscolor $rgb"
1535	SendCmd "grid linecolor $rgb"
1536	$itk_component(legend) itemconfigure text -fill $color
1537	}
1538	}
1539
1540	# ----------------------------------------------------------------------
1541	# CONFIGURATION OPTION: -plotoutline
1542	# ----------------------------------------------------------------------
1543	itcl::configbody Rappture::NanovisViewer::plotoutline {
1544	# Must check if we are connected because this routine is called from the
1545	# class body when the -plotoutline itk_option is defined. At that point
1546	# the NanovisViewer class constructor hasn't been called, so we can't
1547	# start sending commands to visualization server.
1548	if { [isconnected] } {
1549	if {"" == $itk_option(-plotoutline)} {
1550	SendCmd "volume outline state off"
1551	} else {
1552	SendCmd "volume outline state on"
1553	SendCmd "volume outline color [Color2RGB $itk_option(-plotoutline)]"
1554	}
1555	}
1556	}
1557
1558	#
1559	# The -levels option takes a single value that represents the number
1560	# of evenly distributed markers based on the current data range. Each
1561	# marker is a relative value from 0.0 to 1.0.
1562	#
1563	itcl::body Rappture::NanovisViewer::ParseLevelsOption { tf levels } {
1564	set c $itk_component(legend)
1565	regsub -all "," $levels " " levels
1566	if {[string is int $levels]} {
1567	for {set i 1} { $i <= $levels } {incr i} {
1568	set x [expr {double($i)/($levels+1)}]
1569	set m [Rappture::IsoMarker \#auto $c $this $tf]
1570	$itk_component(legend) itemconfigure labels -fill $itk_option(-plotforeground)
1571	$m relval $x
1572	lappend _isomarkers($tf) $m
1573	}
1574	} else {
1575	foreach x $levels {
1576	set m [Rappture::IsoMarker \#auto $c $this $tf]
1577	$itk_component(legend) itemconfigure labels -fill $itk_option(-plotforeground)
1578	$m relval $x
1579	lappend _isomarkers($tf) $m
1580	}
1581	}
1582	}
1583
1584	#
1585	# The -markers option takes a list of zero or more values (the values
1586	# may be separated either by spaces or commas) that have the following
1587	# format:
1588	#
1589	# N% Percent of current total data range. Converted to
1590	# to a relative value between 0.0 and 1.0.
1591	# N Absolute value of marker. If the marker is outside of
1592	# the current range, it will be displayed on the outer
1593	# edge of the legends, but it range it represents will
1594	# not be seen.
1595	#
1596	itcl::body Rappture::NanovisViewer::ParseMarkersOption { tf markers } {
1597	set c $itk_component(legend)
1598	regsub -all "," $markers " " markers
1599	foreach marker $markers {
1600	set n [scan $marker "%g%s" value suffix]
1601	if { $n == 2 && $suffix == "%" } {
1602	# ${n}% : Set relative value.
1603	set value [expr {$value * 0.01}]
1604	set m [Rappture::IsoMarker \#auto $c $this $tf]
1605	$itk_component(legend) itemconfigure labels -fill $itk_option(-plotforeground)
1606	$m relval $value
1607	lappend _isomarkers($tf) $m
1608	} else {
1609	# ${n} : Set absolute value.
1610	set m [Rappture::IsoMarker \#auto $c $this $tf]
1611	$itk_component(legend) itemconfigure labels -fill $itk_option(-plotforeground)
1612	$m absval $value
1613	lappend _isomarkers($tf) $m
1614	}
1615	}
1616	}
1617
1618	itcl::body Rappture::NanovisViewer::updateTransferFunctions {} {
1619	$_dispatcher event -idle !send_transfunc
1620	}
1621
1622	itcl::body Rappture::NanovisViewer::AddIsoMarker { x y } {
1623	if { $_first == "" } {
1624	error "active transfer function isn't set"
1625	}
1626	set tag [lindex [CurrentDatasets] 0]
1627	set tf $_dataset2style($tag)
1628	set c $itk_component(legend)
1629	set m [Rappture::IsoMarker \#auto $c $this $tf]
1630	$itk_component(legend) itemconfigure labels -fill $itk_option(-plotforeground)
1631	set w [winfo width $c]
1632	$m relval [expr {double($x-10)/($w-20)}]
1633	lappend _isomarkers($tf) $m
1634	updateTransferFunctions
1635	return 1
1636	}
1637
1638	itcl::body Rappture::NanovisViewer::removeDuplicateMarker { marker x } {
1639	set tf [$marker transferfunc]
1640	set bool 0
1641	if { [info exists _isomarkers($tf)] } {
1642	set list {}
1643	set marker [namespace tail $marker]
1644	foreach m $_isomarkers($tf) {
1645	set sx [$m screenpos]
1646	if { $m != $marker } {
1647	if { $x >= ($sx-3) && $x <= ($sx+3) } {
1648	$marker relval [$m relval]
1649	itcl::delete object $m
1650	bell
1651	set bool 1
1652	continue
1653	}
1654	}
1655	lappend list $m
1656	}
1657	set _isomarkers($tf) $list
1658	updateTransferFunctions
1659	}
1660	return $bool
1661	}
1662
1663	itcl::body Rappture::NanovisViewer::overMarker { marker x } {
1664	set tf [$marker transferfunc]
1665	if { [info exists _isomarkers($tf)] } {
1666	set marker [namespace tail $marker]
1667	foreach m $_isomarkers($tf) {
1668	set sx [$m screenpos]
1669	if { $m != $marker } {
1670	set bool [expr { $x >= ($sx-3) && $x <= ($sx+3) }]
1671	$m activate $bool
1672	}
1673	}
1674	}
1675	return ""
1676	}
1677
1678	itcl::body Rappture::NanovisViewer::limits { tf } {
1679	set _limits(min) 0.0
1680	set _limits(max) 1.0
1681	if { ![info exists _style2datasets($tf)] } {
1682	return [array get _limits]
1683	}
1684	set min ""; set max ""
1685	foreach tag $_style2datasets($tf) {
1686	if { ![info exists _serverDatasets($tag)] } {
1687	continue
1688	}
1689	if { ![info exists _limits($tag-min)] } {
1690	continue
1691	}
1692	if { $min == "" \|\| $min > $_limits($tag-min) } {
1693	set min $_limits($tag-min)
1694	}
1695	if { $max == "" \|\| $max < $_limits($tag-max) } {
1696	set max $_limits($tag-max)
1697	}
1698	}
1699	if { $min != "" } {
1700	set _limits(min) $min
1701	}
1702	if { $max != "" } {
1703	set _limits(max) $max
1704	}
1705	return [array get _limits]
1706	}
1707
1708	itcl::body Rappture::NanovisViewer::BuildViewTab {} {
1709	set fg [option get $itk_component(hull) font Font]
1710	#set bfg [option get $itk_component(hull) boldFont Font]
1711
1712	set inner [$itk_component(main) insert end \
1713	-title "View Settings" \
1714	-icon [Rappture::icon wrench]]
1715	$inner configure -borderwidth 4
1716
1717	checkbutton $inner.axes \
1718	-text "Axes" \
1719	-variable [itcl::scope _settings(-axesvisible)] \
1720	-command [itcl::code $this AdjustSetting -axesvisible] \
1721	-font "Arial 9"
1722
1723	checkbutton $inner.grid \
1724	-text "Grid" \
1725	-variable [itcl::scope _settings(-gridvisible)] \
1726	-command [itcl::code $this AdjustSetting -gridvisible] \
1727	-font "Arial 9"
1728
1729	checkbutton $inner.outline \
1730	-text "Outline" \
1731	-variable [itcl::scope _settings(-outlinevisible)] \
1732	-command [itcl::code $this AdjustSetting -outlinevisible] \
1733	-font "Arial 9"
1734
1735	checkbutton $inner.legend \
1736	-text "Legend" \
1737	-variable [itcl::scope _settings(-legendvisible)] \
1738	-command [itcl::code $this AdjustSetting -legendvisible] \
1739	-font "Arial 9"
1740
1741	checkbutton $inner.volume \
1742	-text "Volume" \
1743	-variable [itcl::scope _settings(-volume)] \
1744	-command [itcl::code $this AdjustSetting -volume] \
1745	-font "Arial 9"
1746
1747	label $inner.background_l -text "Background" -font "Arial 9"
1748	itk_component add background {
1749	Rappture::Combobox $inner.background -width 10 -editable no
1750	}
1751	$inner.background choices insert end \
1752	"black" "black" \
1753	"white" "white" \
1754	"grey" "grey"
1755
1756	$itk_component(background) value $_settings(-background)
1757	bind $inner.background <<Value>> \
1758	[itcl::code $this AdjustSetting -background]
1759
1760	blt::table $inner \
1761	0,0 $inner.axes -cspan 2 -anchor w \
1762	1,0 $inner.grid -cspan 2 -anchor w \
1763	2,0 $inner.outline -cspan 2 -anchor w \
1764	3,0 $inner.volume -cspan 2 -anchor w \
1765	4,0 $inner.legend -cspan 2 -anchor w \
1766	5,0 $inner.background_l -anchor e -pady 2 \
1767	5,1 $inner.background -fill x
1768
1769	blt::table configure $inner r* -resize none
1770	blt::table configure $inner r6 -resize expand
1771	}
1772
1773	itcl::body Rappture::NanovisViewer::BuildVolumeTab {} {
1774	set inner [$itk_component(main) insert end \
1775	-title "Volume Settings" \
1776	-icon [Rappture::icon volume-on]]
1777	$inner configure -borderwidth 4
1778
1779	set fg [option get $itk_component(hull) font Font]
1780	#set bfg [option get $itk_component(hull) boldFont Font]
1781
1782	checkbutton $inner.vol -text "Show volume" -font $fg \
1783	-variable [itcl::scope _settings(-volume)] \
1784	-command [itcl::code $this AdjustSetting -volume]
1785	label $inner.shading -text "Shading:" -font $fg
1786
1787	checkbutton $inner.isosurface -text "Isosurface shading" -font $fg \
1788	-variable [itcl::scope _settings(-isosurfaceshading)] \
1789	-command [itcl::code $this AdjustSetting -isosurfaceshading]
1790
1791	checkbutton $inner.light2side -text "Two-sided lighting" -font $fg \
1792	-variable [itcl::scope _settings(-light2side)] \
1793	-command [itcl::code $this AdjustSetting -light2side]
1794
1795	label $inner.dim -text "Glow" -font $fg
1796	::scale $inner.light -from 0 -to 100 -orient horizontal \
1797	-variable [itcl::scope _settings(-light)] \
1798	-width 10 \
1799	-showvalue off -command [itcl::code $this AdjustSetting -light]
1800	label $inner.bright -text "Surface" -font $fg
1801
1802	# Opacity
1803	label $inner.clear -text "Clear" -font $fg
1804	::scale $inner.opacity -from 0 -to 100 -orient horizontal \
1805	-variable [itcl::scope _settings(-opacity)] \
1806	-width 10 \
1807	-showvalue off -command [itcl::code $this AdjustSetting -opacity]
1808	label $inner.opaque -text "Opaque" -font $fg
1809
1810	# Tooth thickness
1811	label $inner.thin -text "Thin" -font $fg
1812	::scale $inner.thickness -from 0 -to 1000 -orient horizontal \
1813	-variable [itcl::scope _settings(-thickness)] \
1814	-width 10 \
1815	-showvalue off -command [itcl::code $this AdjustSetting -thickness]
1816	label $inner.thick -text "Thick" -font $fg
1817
1818	# Colormap
1819	label $inner.colormap_l -text "Colormap" -font "Arial 9"
1820	itk_component add colormap {
1821	Rappture::Combobox $inner.colormap -width 10 -editable no
1822	}
1823
1824	$inner.colormap choices insert end [GetColormapList -includeNone]
1825	$itk_component(colormap) value "BCGYR"
1826	bind $inner.colormap <<Value>> \
1827	[itcl::code $this AdjustSetting -colormap]
1828
1829	blt::table $inner \
1830	0,0 $inner.vol -cspan 4 -anchor w -pady 2 \
1831	1,0 $inner.shading -cspan 4 -anchor w -pady {10 2} \
1832	2,0 $inner.light2side -cspan 4 -anchor w -pady 2 \
1833	3,0 $inner.dim -anchor e -pady 2 \
1834	3,1 $inner.light -cspan 2 -pady 2 -fill x \
1835	3,3 $inner.bright -anchor w -pady 2 \
1836	4,0 $inner.clear -anchor e -pady 2 \
1837	4,1 $inner.opacity -cspan 2 -pady 2 -fill x \
1838	4,3 $inner.opaque -anchor w -pady 2 \
1839	5,0 $inner.thin -anchor e -pady 2 \
1840	5,1 $inner.thickness -cspan 2 -pady 2 -fill x\
1841	5,3 $inner.thick -anchor w -pady 2
1842
1843	blt::table configure $inner c0 c1 c3 r* -resize none
1844	blt::table configure $inner r6 -resize expand
1845	}
1846
1847	itcl::body Rappture::NanovisViewer::BuildCutplanesTab {} {
1848	set inner [$itk_component(main) insert end \
1849	-title "Cutplane Settings" \
1850	-icon [Rappture::icon cutbutton]]
1851	$inner configure -borderwidth 4
1852
1853	checkbutton $inner.visible \
1854	-text "Show Cutplanes" \
1855	-variable [itcl::scope _settings(-cutplanesvisible)] \
1856	-command [itcl::code $this AdjustSetting -cutplanesvisible] \
1857	-font "Arial 9"
1858
1859	# X-value slicer...
1860	itk_component add xCutButton {
1861	Rappture::PushButton $inner.xbutton \
1862	-onimage [Rappture::icon x-cutplane] \
1863	-offimage [Rappture::icon x-cutplane] \
1864	-command [itcl::code $this AdjustSetting -xcutplanevisible] \
1865	-variable [itcl::scope _settings(-xcutplanevisible)]
1866	}
1867	Rappture::Tooltip::for $itk_component(xCutButton) \
1868	"Toggle the X cut plane on/off"
1869	#$itk_component(xCutButton) select
1870
1871	itk_component add xCutScale {
1872	::scale $inner.xval -from 100 -to 0 \
1873	-width 10 -orient vertical -showvalue off \
1874	-borderwidth 1 -highlightthickness 0 \
1875	-command [itcl::code $this Slice move x] \
1876	-variable [itcl::scope _settings(-xcutplaneposition)]
1877	} {
1878	usual
1879	ignore -borderwidth -highlightthickness
1880	}
1881	# Set the default cutplane value before disabling the scale.
1882	$itk_component(xCutScale) set 50
1883	$itk_component(xCutScale) configure -state disabled
1884	Rappture::Tooltip::for $itk_component(xCutScale) \
1885	"@[itcl::code $this SlicerTip x]"
1886
1887	# Y-value slicer...
1888	itk_component add yCutButton {
1889	Rappture::PushButton $inner.ybutton \
1890	-onimage [Rappture::icon y-cutplane] \
1891	-offimage [Rappture::icon y-cutplane] \
1892	-command [itcl::code $this AdjustSetting -ycutplanevisible] \
1893	-variable [itcl::scope _settings(-ycutplanevisible)]
1894	}
1895	Rappture::Tooltip::for $itk_component(yCutButton) \
1896	"Toggle the Y cut plane on/off"
1897	#$itk_component(yCutButton) select
1898
1899	itk_component add yCutScale {
1900	::scale $inner.yval -from 100 -to 0 \
1901	-width 10 -orient vertical -showvalue off \
1902	-borderwidth 1 -highlightthickness 0 \
1903	-command [itcl::code $this Slice move y] \
1904	-variable [itcl::scope _settings(-ycutplaneposition)]
1905	} {
1906	usual
1907	ignore -borderwidth -highlightthickness
1908	}
1909	Rappture::Tooltip::for $itk_component(yCutScale) \
1910	"@[itcl::code $this SlicerTip y]"
1911	# Set the default cutplane value before disabling the scale.
1912	$itk_component(yCutScale) set 50
1913	$itk_component(yCutScale) configure -state disabled
1914
1915	# Z-value slicer...
1916	itk_component add zCutButton {
1917	Rappture::PushButton $inner.zbutton \
1918	-onimage [Rappture::icon z-cutplane] \
1919	-offimage [Rappture::icon z-cutplane] \
1920	-command [itcl::code $this AdjustSetting -zcutplanevisible] \
1921	-variable [itcl::scope _settings(-zcutplanevisible)]
1922	}
1923	Rappture::Tooltip::for $itk_component(zCutButton) \
1924	"Toggle the Z cut plane on/off"
1925	#$itk_component(zCutButton) select
1926
1927	itk_component add zCutScale {
1928	::scale $inner.zval -from 100 -to 0 \
1929	-width 10 -orient vertical -showvalue off \
1930	-borderwidth 1 -highlightthickness 0 \
1931	-command [itcl::code $this Slice move z] \
1932	-variable [itcl::scope _settings(-zcutplaneposition)]
1933	} {
1934	usual
1935	ignore -borderwidth -highlightthickness
1936	}
1937	$itk_component(zCutScale) set 50
1938	$itk_component(zCutScale) configure -state disabled
1939	Rappture::Tooltip::for $itk_component(zCutScale) \
1940	"@[itcl::code $this SlicerTip z]"
1941
1942	blt::table $inner \
1943	0,1 $itk_component(xCutScale) \
1944	0,2 $itk_component(yCutScale) \
1945	0,3 $itk_component(zCutScale) \
1946	1,1 $itk_component(xCutButton) \
1947	1,2 $itk_component(yCutButton) \
1948	1,3 $itk_component(zCutButton)
1949
1950	# 0,1 $inner.visible -anchor w -pady 2 -cspan 4 \
1951
1952	blt::table configure $inner r0 r1 r2 c* -resize none
1953	blt::table configure $inner r3 c4 -resize expand
1954	blt::table configure $inner c0 -width 2
1955	blt::table configure $inner c1 c2 c3 -padx 2
1956	}
1957
1958	itcl::body Rappture::NanovisViewer::BuildCameraTab {} {
1959	set inner [$itk_component(main) insert end \
1960	-title "Camera Settings" \
1961	-icon [Rappture::icon camera]]
1962	$inner configure -borderwidth 4
1963
1964	label $inner.view_l -text "view" -font "Arial 9"
1965	set f [frame $inner.view]
1966	foreach side { front back left right top bottom } {
1967	button $f.$side -image [Rappture::icon view$side] \
1968	-command [itcl::code $this SetOrientation $side]
1969	Rappture::Tooltip::for $f.$side "Change the view to $side"
1970	pack $f.$side -side left
1971	}
1972
1973	blt::table $inner \
1974	0,0 $inner.view_l -anchor e -pady 2 \
1975	0,1 $inner.view -anchor w -pady 2
1976	blt::table configure $inner r0 -resize none
1977
1978	set row 1
1979	set labels { qw qx qy qz xpan ypan zoom }
1980	foreach tag $labels {
1981	label $inner.${tag}label -text $tag -font "Arial 9"
1982	entry $inner.${tag} -font "Arial 9" -bg white \
1983	-textvariable [itcl::scope _settings(-$tag)]
1984	bind $inner.${tag} <Return> \
1985	[itcl::code $this camera set -${tag}]
1986	bind $inner.${tag} <KP_Enter> \
1987	[itcl::code $this camera set -${tag}]
1988	blt::table $inner \
1989	$row,0 $inner.${tag}label -anchor e -pady 2 \
1990	$row,1 $inner.${tag} -anchor w -pady 2
1991	blt::table configure $inner r$row -resize none
1992	incr row
1993	}
1994
1995	blt::table configure $inner c* -resize none
1996	blt::table configure $inner c2 -resize expand
1997	blt::table configure $inner r$row -resize expand
1998	}
1999
2000	# ----------------------------------------------------------------------
2001	# USAGE: Slice move x\|y\|z <newval>
2002	#
2003	# Called automatically when the user drags the slider to move the
2004	# cut plane that slices 3D data. Gets the current value from the
2005	# slider and moves the cut plane to the appropriate point in the
2006	# data set.
2007	# ----------------------------------------------------------------------
2008	itcl::body Rappture::NanovisViewer::Slice {option args} {
2009	switch -- $option {
2010	move {
2011	if {[llength $args] != 2} {
2012	error "wrong # args: should be \"Slice move x\|y\|z newval\""
2013	}
2014	set axis [lindex $args 0]
2015	set newval [lindex $args 1]
2016
2017	set newpos [expr {0.01*$newval}]
2018	set datasets [CurrentDatasets -cutplanes]
2019	set tag [lindex $datasets 0]
2020	SendCmd "cutplane position $newpos $axis $tag"
2021	}
2022	default {
2023	error "bad option \"$option\": should be axis, move, or volume"
2024	}
2025	}
2026	}
2027
2028	# ----------------------------------------------------------------------
2029	# USAGE: SlicerTip <axis>
2030	#
2031	# Used internally to generate a tooltip for the x/y/z slicer controls.
2032	# Returns a message that includes the current slicer value.
2033	# ----------------------------------------------------------------------
2034	itcl::body Rappture::NanovisViewer::SlicerTip {axis} {
2035	set val [$itk_component(${axis}CutScale) get]
2036	return "Move the [string toupper $axis] cut plane.\nCurrently: $axis = $val%"
2037	}
2038
2039	itcl::body Rappture::NanovisViewer::DoResize {} {
2040	$_arcball resize $_width $_height
2041	SendCmd "screen size $_width $_height"
2042	set _resizePending 0
2043	}
2044
2045	itcl::body Rappture::NanovisViewer::EventuallyResize { w h } {
2046	set _width $w
2047	set _height $h
2048	$_arcball resize $w $h
2049	if { !$_resizePending } {
2050	$_dispatcher event -idle !resize
2051	set _resizePending 1
2052	}
2053	}
2054
2055	itcl::body Rappture::NanovisViewer::EventuallyRedrawLegend {} {
2056	if { !$_resizeLegendPending } {
2057	$_dispatcher event -idle !legend
2058	set _resizeLegendPending 1
2059	}
2060	}
2061
2062	# camera --
2063	#
2064	itcl::body Rappture::NanovisViewer::camera {option args} {
2065	switch -- $option {
2066	"show" {
2067	puts [array get _view]
2068	}
2069	"set" {
2070	set what [lindex $args 0]
2071	set x $_settings($what)
2072	set code [catch { string is double $x } result]
2073	if { $code != 0 \|\| !$result } {
2074	set _settings($what) $_view($what)
2075	return
2076	}
2077	switch -- $what {
2078	"-xpan" - "-ypan" {
2079	set _view($what) $_settings($what)
2080	PanCamera
2081	}
2082	"-qx" - "-qy" - "-qz" - "-qw" {
2083	set _view($what) $_settings($what)
2084	set q [ViewToQuaternion]
2085	$_arcball quaternion $q
2086	SendCmd "camera orient $q"
2087	}
2088	"-zoom" {
2089	set _view($what) $_settings($what)
2090	SendCmd "camera zoom $_view($what)"
2091	}
2092	}
2093	}
2094	}
2095	}
2096
2097	itcl::body Rappture::NanovisViewer::GetVtkData { args } {
2098	# FIXME: We can only put one component of one dataset in a single
2099	# VTK file. To download all components/results, we would need
2100	# to put them in an archive (e.g. zip or tar file)
2101	if { $_first != ""} {
2102	set cname [lindex [$_first components] 0]
2103	set bytes [$_first vtkdata $cname]
2104	return [list .vtk $bytes]
2105	}
2106	puts stderr "Failed to get vtkdata"
2107	return ""
2108	}
2109
2110	itcl::body Rappture::NanovisViewer::GetImage { args } {
2111	if { [image width $_image(download)] > 0 &&
2112	[image height $_image(download)] > 0 } {
2113	set bytes [$_image(download) data -format "jpeg -quality 100"]
2114	set bytes [Rappture::encoding::decode -as b64 $bytes]
2115	return [list .jpg $bytes]
2116	}
2117	return ""
2118	}
2119
2120	itcl::body Rappture::NanovisViewer::BuildDownloadPopup { popup command } {
2121	Rappture::Balloon $popup \
2122	-title "[Rappture::filexfer::label downloadWord] as..."
2123	set inner [$popup component inner]
2124	label $inner.summary -text "" -anchor w
2125
2126	radiobutton $inner.vtk_button -text "VTK data file" \
2127	-variable [itcl::scope _downloadPopup(format)] \
2128	-font "Arial 9" \
2129	-value vtk
2130	Rappture::Tooltip::for $inner.vtk_button "Save as VTK data file."
2131
2132	radiobutton $inner.image_button -text "Image File" \
2133	-variable [itcl::scope _downloadPopup(format)] \
2134	-font "Arial 9" \
2135	-value image
2136	Rappture::Tooltip::for $inner.image_button \
2137	"Save as digital image."
2138
2139	button $inner.ok -text "Save" \
2140	-highlightthickness 0 -pady 2 -padx 3 \
2141	-command $command \
2142	-compound left \
2143	-image [Rappture::icon download]
2144
2145	button $inner.cancel -text "Cancel" \
2146	-highlightthickness 0 -pady 2 -padx 3 \
2147	-command [list $popup deactivate] \
2148	-compound left \
2149	-image [Rappture::icon cancel]
2150
2151	blt::table $inner \
2152	0,0 $inner.summary -cspan 2 \
2153	1,0 $inner.vtk_button -anchor w -cspan 2 -padx { 4 0 } \
2154	2,0 $inner.image_button -anchor w -cspan 2 -padx { 4 0 } \
2155	4,1 $inner.cancel -width .9i -fill y \
2156	4,0 $inner.ok -padx 2 -width .9i -fill y
2157	blt::table configure $inner r3 -height 4
2158	blt::table configure $inner r4 -pady 4
2159	raise $inner.image_button
2160	$inner.vtk_button invoke
2161	return $inner
2162	}
2163
2164	itcl::body Rappture::NanovisViewer::SetOrientation { side } {
2165	array set positions {
2166	front "1 0 0 0"
2167	back "0 0 1 0"
2168	left "0.707107 0 -0.707107 0"
2169	right "0.707107 0 0.707107 0"
2170	top "0.707107 -0.707107 0 0"
2171	bottom "0.707107 0.707107 0 0"
2172	}
2173	foreach name { -qw -qx -qy -qz } value $positions($side) {
2174	set _view($name) $value
2175	}
2176	set q [ViewToQuaternion]
2177	$_arcball quaternion $q
2178	SendCmd "camera orient $q"
2179	SendCmd "camera reset"
2180	set _view(-xpan) 0
2181	set _view(-ypan) 0
2182	set _view(-zoom) 1.0
2183	set _settings(-xpan) $_view(-xpan)
2184	set _settings(-ypan) $_view(-ypan)
2185	set _settings(-zoom) $_view(-zoom)
2186	}

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

Context Navigation

source: branches/blt4_trunk/gui/scripts/nanovisviewer.tcl @ 6681

Download in other formats: