Context Navigation

source: trunk/gui/scripts/flowvisviewer.tcl @ 3485

Last change on this file since 3485 was 3485, checked in by ldelgass, 11 years ago
Remove euler angle support from nanovis clients, also prep. camera resets (currently commented out).
File size: 102.8 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2	# ----------------------------------------------------------------------
3	# COMPONENT: flowvisviewer - 3D flow rendering
4	#
5	#
6	# This widget performs volume and flow rendering on 3D scalar/vector datasets.
7	# It connects to the Flowvis server running on a rendering farm, transmits
8	# data, and displays the results.
9	#
10	# ======================================================================
11	# AUTHOR: Michael McLennan, Purdue University
12	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
13	#
14	# See the file "license.terms" for information on usage and redistribution of
15	# this file, and for a DISCLAIMER OF ALL WARRANTIES.
16	# ======================================================================
17	package require Itk
18	package require BLT
19	package require Img
20
21	option add *FlowvisViewer.width 5i widgetDefault
22	option add FlowvisViewercursor crosshair widgetDefault
23	option add *FlowvisViewer.height 4i widgetDefault
24	option add *FlowvisViewer.foreground black widgetDefault
25	option add *FlowvisViewer.controlBackground gray widgetDefault
26	option add *FlowvisViewer.controlDarkBackground #999999 widgetDefault
27	option add *FlowvisViewer.plotBackground black widgetDefault
28	option add *FlowvisViewer.plotForeground white widgetDefault
29	option add *FlowvisViewer.plotOutline gray widgetDefault
30	option add *FlowvisViewer.font \
31	--helvetica-medium-r-normal--12-* widgetDefault
32
33	# must use this name -- plugs into Rappture::resources::load
34	proc FlowvisViewer_init_resources {} {
35	Rappture::resources::register \
36	nanovis_server Rappture::FlowvisViewer::SetServerList
37	}
38
39	itcl::class Rappture::FlowvisViewer {
40	inherit Rappture::VisViewer
41
42	itk_option define -plotforeground plotForeground Foreground ""
43	itk_option define -plotbackground plotBackground Background ""
44	itk_option define -plotoutline plotOutline PlotOutline ""
45
46	constructor { hostlist args } {
47	Rappture::VisViewer::constructor $hostlist
48	} {
49	# defined below
50	}
51	destructor {
52	# defined below
53	}
54	public proc SetServerList { namelist } {
55	Rappture::VisViewer::SetServerList "nanovis" $namelist
56	}
57	public method add {dataobj {settings ""}}
58	public method camera {option args}
59	public method delete {args}
60	public method disconnect {}
61	public method download {option args}
62	public method flow {option}
63	public method get {args}
64	public method isconnected {}
65	public method limits { tf }
66	public method overmarker { m x }
67	public method parameters {title args} {
68	# do nothing
69	}
70	public method rmdupmarker { m x }
71	public method scale {args}
72	public method updatetransferfuncs {}
73
74	protected method Connect {}
75	protected method CurrentVolumeIds {{what -all}}
76	protected method Disconnect {}
77	protected method Resize {}
78	protected method ResizeLegend {}
79	protected method AdjustSetting {what {value ""}}
80	protected method InitSettings { args }
81	protected method Pan {option x y}
82	protected method Rebuild {}
83	protected method ReceiveData { args }
84	protected method ReceiveImage { args }
85	protected method ReceiveLegend { tf vmin vmax size }
86	protected method Rotate {option x y}
87	protected method SendDataObjs {}
88	protected method SendTransferFuncs {}
89	protected method Slice {option args}
90	protected method SlicerTip {axis}
91	protected method Zoom {option}
92
93	# soon to be removed.
94	protected method Flow {option args}
95	protected method Play {}
96	protected method Pause {}
97
98
99	# The following methods are only used by this class.
100
101	private method AddIsoMarker { x y }
102	private method BuildCameraTab {}
103	private method BuildCutplanesTab {}
104	private method BuildViewTab {}
105	private method BuildVolumeTab {}
106	private method ComputeTransferFunc { tf }
107	private method EventuallyResize { w h }
108	private method EventuallyGoto { nSteps }
109	private method EventuallyResizeLegend { }
110	private method FlowCmd { dataobj comp nbytes extents }
111	private method GetMovie { widget width height }
112	private method GetPngImage { widget width height }
113	private method NameTransferFunc { dataobj comp }
114	private method PanCamera {}
115	private method ParseLevelsOption { tf levels }
116	private method ParseMarkersOption { tf markers }
117	private method WaitIcon { option widget }
118	private method str2millisecs { value }
119	private method millisecs2str { value }
120	private method GetFlowInfo { widget }
121	private method particles { tag name }
122	private method box { tag name }
123	private method streams { tag name }
124	private method arrows { tag name }
125
126	private variable _arcball ""
127	private variable _dlist "" ;# list of data objects
128	private variable _allDataObjs
129	private variable _obj2ovride ;# maps dataobj => style override
130	private variable _serverObjs ;# maps dataobj-component to volume ID
131	# in the server
132	private variable _sendobjs "" ;# list of data objs to send to server
133	private variable _recvObjs ;# list of data objs to send to server
134	private variable _obj2style ;# maps dataobj-component to transfunc
135	private variable _style2objs ;# maps tf back to list of
136	# dataobj-components using the tf.
137	private variable _obj2flow; # Maps dataobj-component to a flow.
138
139	private variable _reset 1; # Connection to server has been reset
140	private variable _click ;# info used for rotate operations
141	private variable _limits ;# autoscale min/max for all axes
142	private variable _view ;# view params for 3D view
143	private variable _isomarkers ;# array of isosurface level values 0..1
144	private common _settings
145	private variable _activeTf "" ;# The currently active transfer function.
146	private variable _first "" ;# This is the topmost volume.
147	private variable _nextToken 0
148	private variable _icon 0
149	private variable _flow
150	# This
151	# indicates which isomarkers and transfer
152	# function to use when changing markers,
153	# opacity, or thickness.
154	private common _downloadPopup ;# download options from popup
155
156	private common _hardcopy
157	private variable _width 0
158	private variable _height 0
159	private variable _resizePending 0
160	private variable _resizeLegendPending 0
161	private variable _gotoPending 0
162	}
163
164	itk::usual FlowvisViewer {
165	keep -background -foreground -cursor -font
166	keep -plotbackground -plotforeground
167	}
168
169	# ----------------------------------------------------------------------
170	# CONSTRUCTOR
171	# ----------------------------------------------------------------------
172	itcl::body Rappture::FlowvisViewer::constructor { hostlist args } {
173	set _serverType "nanovis"
174
175	# Draw legend event
176	$_dispatcher register !legend
177	$_dispatcher dispatch $this !legend "[itcl::code $this ResizeLegend]; list"
178
179	# Send dataobjs event
180	$_dispatcher register !send_dataobjs
181	$_dispatcher dispatch $this !send_dataobjs \
182	"[itcl::code $this SendDataObjs]; list"
183
184	# Send transferfunctions event
185	$_dispatcher register !send_transfunc
186	$_dispatcher dispatch $this !send_transfunc \
187	"[itcl::code $this SendTransferFuncs]; list"
188
189	# Rebuild event.
190	$_dispatcher register !rebuild
191	$_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
192
193	# Resize event.
194	$_dispatcher register !resize
195	$_dispatcher dispatch $this !resize "[itcl::code $this Resize]; list"
196
197	$_dispatcher register !play
198	$_dispatcher dispatch $this !play "[itcl::code $this flow next]; list"
199
200	# Draw legend event
201	$_dispatcher register !goto
202	$_dispatcher dispatch $this !goto "[itcl::code $this flow goto2]; list"
203
204	$_dispatcher register !movietimeout
205	$_dispatcher register !waiticon
206
207	set _flow(state) 0
208
209	array set _downloadPopup {
210	format draft
211	}
212	#
213	# Populate parser with commands handle incoming requests
214	#
215	$_parser alias image [itcl::code $this ReceiveImage]
216	$_parser alias legend [itcl::code $this ReceiveLegend]
217	$_parser alias data [itcl::code $this ReceiveData]
218
219	# Initialize the view to some default parameters.
220	array set _view {
221	qw 0.853553
222	qx -0.353553
223	qy 0.353553
224	qz 0.146447
225	zoom 1.0
226	pan-x 0
227	pan-y 0
228	}
229	set _arcball [blt::arcball create 100 100]
230	set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
231	$_arcball quaternion $q
232
233	set _limits(vmin) 0.0
234	set _limits(vmax) 1.0
235	set _reset 1
236
237	array set _settings [subst {
238	$this-qw $_view(qw)
239	$this-qx $_view(qx)
240	$this-qy $_view(qy)
241	$this-qz $_view(qz)
242	$this-zoom $_view(zoom)
243	$this-pan-x $_view(pan-x)
244	$this-pan-y $_view(pan-y)
245	$this-arrows 0
246	$this-currenttime 0
247	$this-duration 1:00
248	$this-loop 0
249	$this-play 0
250	$this-speed 500
251	$this-step 0
252	$this-streams 0
253	$this-volume 1
254	$this-xcutplane 0
255	$this-xcutposition 0
256	$this-ycutplane 0
257	$this-ycutposition 0
258	$this-zcutplane 0
259	$this-zcutposition 0
260	}]
261
262	itk_component add 3dview {
263	label $itk_component(plotarea).view -image $_image(plot) \
264	-highlightthickness 0 -borderwidth 0
265	} {
266	usual
267	ignore -highlightthickness -borderwidth -background
268	}
269	bind $itk_component(3dview) <Control-F1> [itcl::code $this ToggleConsole]
270
271	set f [$itk_component(main) component controls]
272	itk_component add reset {
273	button $f.reset -borderwidth 1 -padx 1 -pady 1 \
274	-highlightthickness 0 \
275	-image [Rappture::icon reset-view] \
276	-command [itcl::code $this Zoom reset]
277	} {
278	usual
279	ignore -highlightthickness
280	}
281	pack $itk_component(reset) -side top -padx 2 -pady 2
282	Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
283
284	itk_component add zoomin {
285	button $f.zin -borderwidth 1 -padx 1 -pady 1 \
286	-highlightthickness 0 \
287	-image [Rappture::icon zoom-in] \
288	-command [itcl::code $this Zoom in]
289	} {
290	usual
291	ignore -highlightthickness
292	}
293	pack $itk_component(zoomin) -side top -padx 2 -pady 2
294	Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
295
296	itk_component add zoomout {
297	button $f.zout -borderwidth 1 -padx 1 -pady 1 \
298	-highlightthickness 0 \
299	-image [Rappture::icon zoom-out] \
300	-command [itcl::code $this Zoom out]
301	} {
302	usual
303	ignore -highlightthickness
304	}
305	pack $itk_component(zoomout) -side top -padx 2 -pady 2
306	Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
307
308	itk_component add volume {
309	Rappture::PushButton $f.volume \
310	-onimage [Rappture::icon volume-on] \
311	-offimage [Rappture::icon volume-off] \
312	-command [itcl::code $this AdjustSetting volume] \
313	-variable [itcl::scope _settings($this-volume)]
314	}
315	$itk_component(volume) select
316	Rappture::Tooltip::for $itk_component(volume) \
317	"Toggle the volume cloud on/off"
318	pack $itk_component(volume) -padx 2 -pady 2
319
320	BuildViewTab
321	BuildVolumeTab
322	BuildCutplanesTab
323	BuildCameraTab
324
325	bind $itk_component(3dview) <Configure> \
326	[itcl::code $this EventuallyResize %w %h]
327
328	# Legend
329	set _image(legend) [image create photo]
330	itk_component add legend {
331	canvas $itk_component(plotarea).legend \
332	-height 50 -highlightthickness 0 -background black
333	} {
334	usual
335	ignore -highlightthickness
336	rename -background -plotbackground plotBackground Background
337	}
338	bind $itk_component(legend) <Configure> \
339	[itcl::code $this EventuallyResizeLegend]
340
341	# Hack around the Tk panewindow. The problem is that the requested
342	# size of the 3d view isn't set until an image is retrieved from
343	# the server. So the panewindow uses the tiny size.
344	set w 10000
345	pack forget $itk_component(3dview)
346	blt::table $itk_component(plotarea) \
347	0,0 $itk_component(3dview) -fill both -reqwidth $w \
348	1,0 $itk_component(legend) -fill x
349	blt::table configure $itk_component(plotarea) r1 -resize none
350	# Create flow controls...
351
352	itk_component add flowcontrols {
353	frame $itk_interior.flowcontrols
354	} {
355	usual
356	rename -background -controlbackground controlBackground Background
357	}
358	pack forget $itk_component(main)
359	blt::table $itk_interior \
360	0,0 $itk_component(main) -fill both \
361	1,0 $itk_component(flowcontrols) -fill x
362	blt::table configure $itk_interior r1 -resize none
363
364	# Rewind
365	itk_component add rewind {
366	button $itk_component(flowcontrols).reset \
367	-borderwidth 1 -padx 1 -pady 1 \
368	-image [Rappture::icon flow-rewind] \
369	-command [itcl::code $this flow reset]
370	} {
371	usual
372	ignore -borderwidth
373	rename -highlightbackground -controlbackground controlBackground \
374	Background
375	}
376	Rappture::Tooltip::for $itk_component(rewind) \
377	"Rewind flow"
378
379	# Stop
380	itk_component add stop {
381	button $itk_component(flowcontrols).stop \
382	-borderwidth 1 -padx 1 -pady 1 \
383	-image [Rappture::icon flow-stop] \
384	-command [itcl::code $this flow stop]
385	} {
386	usual
387	ignore -borderwidth
388	rename -highlightbackground -controlbackground controlBackground \
389	Background
390	}
391	Rappture::Tooltip::for $itk_component(stop) \
392	"Stop flow"
393
394	# Play
395	itk_component add play {
396	Rappture::PushButton $itk_component(flowcontrols).play \
397	-onimage [Rappture::icon flow-pause] \
398	-offimage [Rappture::icon flow-play] \
399	-variable [itcl::scope _settings($this-play)] \
400	-command [itcl::code $this flow toggle]
401	}
402	set fg [option get $itk_component(hull) font Font]
403	Rappture::Tooltip::for $itk_component(play) \
404	"Play/Pause flow"
405
406	# Loop
407	itk_component add loop {
408	Rappture::PushButton $itk_component(flowcontrols).loop \
409	-onimage [Rappture::icon flow-loop] \
410	-offimage [Rappture::icon flow-loop] \
411	-variable [itcl::scope _settings($this-loop)]
412	}
413	Rappture::Tooltip::for $itk_component(loop) \
414	"Play continuously"
415
416	itk_component add dial {
417	Rappture::Flowdial $itk_component(flowcontrols).dial \
418	-length 10 -valuewidth 0 -valuepadding 0 -padding 6 \
419	-linecolor "" -activelinecolor "" \
420	-min 0.0 -max 1.0 \
421	-variable [itcl::scope _settings($this-currenttime)] \
422	-knobimage [Rappture::icon knob2] -knobposition center@middle
423	} {
424	usual
425	ignore -dialprogresscolor
426	rename -background -controlbackground controlBackground Background
427	}
428	$itk_component(dial) current 0.0
429	bind $itk_component(dial) <<Value>> [itcl::code $this flow goto]
430	# Duration
431	itk_component add duration {
432	entry $itk_component(flowcontrols).duration \
433	-textvariable [itcl::scope _settings($this-duration)] \
434	-bg white -width 6 -font "arial 9"
435	} {
436	usual
437	ignore -highlightthickness -background
438	}
439	bind $itk_component(duration) <Return> [itcl::code $this flow duration]
440	bind $itk_component(duration) <KP_Enter> [itcl::code $this flow duration]
441	bind $itk_component(duration) <Tab> [itcl::code $this flow duration]
442	Rappture::Tooltip::for $itk_component(duration) \
443	"Set duration of flow (format is min:sec)"
444
445
446	itk_component add durationlabel {
447	label $itk_component(flowcontrols).durationl \
448	-text "Duration:" -font $fg \
449	-highlightthickness 0
450	} {
451	usual
452	ignore -highlightthickness
453	rename -background -controlbackground controlBackground Background
454	}
455
456	itk_component add speedlabel {
457	label $itk_component(flowcontrols).speedl -text "Speed:" -font $fg \
458	-highlightthickness 0
459	} {
460	usual
461	ignore -highlightthickness
462	rename -background -controlbackground controlBackground Background
463	}
464
465	# Speed
466	itk_component add speed {
467	Rappture::Flowspeed $itk_component(flowcontrols).speed \
468	-min 1 -max 10 -width 3 -font "arial 9"
469	} {
470	usual
471	ignore -highlightthickness
472	rename -background -controlbackground controlBackground Background
473	}
474	Rappture::Tooltip::for $itk_component(speed) \
475	"Change speed of flow"
476
477	$itk_component(speed) value 1
478	bind $itk_component(speed) <<Value>> [itcl::code $this flow speed]
479
480
481	blt::table $itk_component(flowcontrols) \
482	0,0 $itk_component(rewind) -padx {3 0} \
483	0,1 $itk_component(stop) -padx {2 0} \
484	0,2 $itk_component(play) -padx {2 0} \
485	0,3 $itk_component(loop) -padx {2 0} \
486	0,4 $itk_component(dial) -fill x -padx {2 0 } \
487	0,5 $itk_component(duration) -padx { 0 0} \
488	0,7 $itk_component(speed) -padx {2 3}
489
490	# 0,6 $itk_component(speedlabel) -padx {2 0}
491	blt::table configure $itk_component(flowcontrols) c* -resize none
492	blt::table configure $itk_component(flowcontrols) c4 -resize both
493	blt::table configure $itk_component(flowcontrols) r0 -pady 1
494	# Bindings for rotation via mouse
495	bind $itk_component(3dview) <ButtonPress-1> \
496	[itcl::code $this Rotate click %x %y]
497	bind $itk_component(3dview) <B1-Motion> \
498	[itcl::code $this Rotate drag %x %y]
499	bind $itk_component(3dview) <ButtonRelease-1> \
500	[itcl::code $this Rotate release %x %y]
501
502	bind $itk_component(3dview) <Configure> \
503	[itcl::code $this EventuallyResize %w %h]
504
505	# Bindings for panning via mouse
506	bind $itk_component(3dview) <ButtonPress-2> \
507	[itcl::code $this Pan click %x %y]
508	bind $itk_component(3dview) <B2-Motion> \
509	[itcl::code $this Pan drag %x %y]
510	bind $itk_component(3dview) <ButtonRelease-2> \
511	[itcl::code $this Pan release %x %y]
512
513	# Bindings for panning via keyboard
514	bind $itk_component(3dview) <KeyPress-Left> \
515	[itcl::code $this Pan set -10 0]
516	bind $itk_component(3dview) <KeyPress-Right> \
517	[itcl::code $this Pan set 10 0]
518	bind $itk_component(3dview) <KeyPress-Up> \
519	[itcl::code $this Pan set 0 -10]
520	bind $itk_component(3dview) <KeyPress-Down> \
521	[itcl::code $this Pan set 0 10]
522	bind $itk_component(3dview) <Shift-KeyPress-Left> \
523	[itcl::code $this Pan set -2 0]
524	bind $itk_component(3dview) <Shift-KeyPress-Right> \
525	[itcl::code $this Pan set 2 0]
526	bind $itk_component(3dview) <Shift-KeyPress-Up> \
527	[itcl::code $this Pan set 0 -2]
528	bind $itk_component(3dview) <Shift-KeyPress-Down> \
529	[itcl::code $this Pan set 0 2]
530
531	# Bindings for zoom via keyboard
532	bind $itk_component(3dview) <KeyPress-Prior> \
533	[itcl::code $this Zoom out]
534	bind $itk_component(3dview) <KeyPress-Next> \
535	[itcl::code $this Zoom in]
536
537	bind $itk_component(3dview) <Enter> "focus $itk_component(3dview)"
538
539	if {[string equal "x11" [tk windowingsystem]]} {
540	# Bindings for zoom via mouse
541	bind $itk_component(3dview) <4> [itcl::code $this Zoom out]
542	bind $itk_component(3dview) <5> [itcl::code $this Zoom in]
543	}
544
545	set _image(download) [image create photo]
546
547	eval itk_initialize $args
548
549	Connect
550	}
551
552	# ----------------------------------------------------------------------
553	# DESTRUCTOR
554	# ----------------------------------------------------------------------
555	itcl::body Rappture::FlowvisViewer::destructor {} {
556	set _sendobjs "" ;# stop any send in progress
557	$_dispatcher cancel !rebuild
558	$_dispatcher cancel !send_dataobjs
559	$_dispatcher cancel !send_transfunc
560	image delete $_image(plot)
561	image delete $_image(legend)
562	image delete $_image(download)
563	catch { blt::arcball destroy $_arcball }
564	array unset _settings $this-*
565	}
566
567	# ----------------------------------------------------------------------
568	# USAGE: add <dataobj> ?<settings>?
569	#
570	# Clients use this to add a data object to the plot. The optional
571	# <settings> are used to configure the plot. Allowed settings are
572	# -color, -brightness, -width, -linestyle, and -raise.
573	# ----------------------------------------------------------------------
574	itcl::body Rappture::FlowvisViewer::add {dataobj {settings ""}} {
575	array set params {
576	-color auto
577	-width 1
578	-linestyle solid
579	-brightness 0
580	-raise 0
581	-description ""
582	-param ""
583	}
584	foreach {opt val} $settings {
585	if {![info exists params($opt)]} {
586	error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
587	}
588	set params($opt) $val
589	}
590	if {$params(-color) == "auto" \|\| $params(-color) == "autoreset"} {
591	# can't handle -autocolors yet
592	set params(-color) black
593	}
594	foreach comp [$dataobj components] {
595	set flowobj [$dataobj flowhints $comp]
596	if { $flowobj == "" } {
597	puts stderr "no flowhints $dataobj-$comp"
598	continue
599	}
600	set _obj2flow($dataobj-$comp) $flowobj
601	}
602	set pos [lsearch -exact $dataobj $_dlist]
603	if {$pos < 0} {
604	lappend _dlist $dataobj
605	set _allDataObjs($dataobj) 1
606	set _obj2ovride($dataobj-color) $params(-color)
607	set _obj2ovride($dataobj-width) $params(-width)
608	set _obj2ovride($dataobj-raise) $params(-raise)
609	$_dispatcher event -idle !rebuild
610	}
611	}
612
613	# ----------------------------------------------------------------------
614	# USAGE: get ?-objects?
615	# USAGE: get ?-image 3dview\|legend?
616	#
617	# Clients use this to query the list of objects being plotted, in
618	# order from bottom to top of this result. The optional "-image"
619	# flag can also request the internal images being shown.
620	# ----------------------------------------------------------------------
621	itcl::body Rappture::FlowvisViewer::get {args} {
622	if {[llength $args] == 0} {
623	set args "-objects"
624	}
625
626	set op [lindex $args 0]
627	switch -- $op {
628	-objects {
629	# put the dataobj list in order according to -raise options
630	set dlist $_dlist
631	foreach obj $dlist {
632	if {[info exists _obj2ovride($obj-raise)] && $_obj2ovride($obj-raise)} {
633	set i [lsearch -exact $dlist $obj]
634	if {$i >= 0} {
635	set dlist [lreplace $dlist $i $i]
636	lappend dlist $obj
637	}
638	}
639	}
640	return $dlist
641	}
642	-image {
643	if {[llength $args] != 2} {
644	error "wrong # args: should be \"get -image 3dview\|legend\""
645	}
646	switch -- [lindex $args end] {
647	3dview {
648	return $_image(plot)
649	}
650	legend {
651	return $_image(legend)
652	}
653	default {
654	error "bad image name \"[lindex $args end]\": should be 3dview or legend"
655	}
656	}
657	}
658	default {
659	error "bad option \"$op\": should be -objects or -image"
660	}
661	}
662	}
663
664	# ----------------------------------------------------------------------
665	# USAGE: delete ?<dataobj1> <dataobj2> ...?
666	#
667	# Clients use this to delete a dataobj from the plot. If no dataobjs
668	# are specified, then all dataobjs are deleted. No data objects are
669	# deleted. They are only removed from the display list.
670	#
671	# ----------------------------------------------------------------------
672	itcl::body Rappture::FlowvisViewer::delete {args} {
673	flow stop
674	if {[llength $args] == 0} {
675	set args $_dlist
676	}
677
678	# Delete all specified dataobjs
679	set changed 0
680	foreach dataobj $args {
681	set pos [lsearch -exact $_dlist $dataobj]
682	if { $pos >= 0 } {
683	foreach comp [$dataobj components] {
684	array unset _limits $dataobj-$comp-*
685	}
686	set _dlist [lreplace $_dlist $pos $pos]
687	array unset _obj2ovride $dataobj-*
688	array unset _obj2flow $dataobj-*
689	array unset _serverObjs $dataobj-*
690	array unset _obj2style $dataobj-*
691	set changed 1
692	}
693	}
694	# If anything changed, then rebuild the plot
695	if {$changed} {
696	# Repair the reverse lookup
697	foreach tf [array names _style2objs] {
698	set list {}
699	foreach {dataobj comp} $_style2objs($tf) break
700	if { [info exists _serverObjs($dataobj-$comp)] } {
701	lappend list $dataobj $comp
702	}
703	if { $list == "" } {
704	array unset _style2objs $tf
705	} else {
706	set _style2objs($tf) $list
707	}
708	}
709	$_dispatcher event -idle !rebuild
710	}
711	}
712
713	# ----------------------------------------------------------------------
714	# USAGE: scale ?<data1> <data2> ...?
715	#
716	# Sets the default limits for the overall plot according to the
717	# limits of the data for all of the given <data> objects. This
718	# accounts for all objects--even those not showing on the screen.
719	# Because of this, the limits are appropriate for all objects as
720	# the user scans through data in the ResultSet viewer.
721	# ----------------------------------------------------------------------
722	itcl::body Rappture::FlowvisViewer::scale {args} {
723	foreach val {xmin xmax ymin ymax vmin vmax} {
724	set _limits($val) ""
725	}
726	foreach obj $args {
727	foreach axis {x y v} {
728
729	foreach { min max } [$obj limits $axis] break
730
731	if {"" != $min && "" != $max} {
732	if {"" == $_limits(${axis}min)} {
733	set _limits(${axis}min) $min
734	set _limits(${axis}max) $max
735	} else {
736	if {$min < $_limits(${axis}min)} {
737	set _limits(${axis}min) $min
738	}
739	if {$max > $_limits(${axis}max)} {
740	set _limits(${axis}max) $max
741	}
742	}
743	}
744	}
745	}
746	}
747
748	# ----------------------------------------------------------------------
749	# USAGE: download coming
750	# USAGE: download controls <downloadCommand>
751	# USAGE: download now
752	#
753	# Clients use this method to create a downloadable representation
754	# of the plot. Returns a list of the form {ext string}, where
755	# "ext" is the file extension (indicating the type of data) and
756	# "string" is the data itself.
757	# ----------------------------------------------------------------------
758	itcl::body Rappture::FlowvisViewer::download {option args} {
759	set popup .flowvisviewerdownload
760	switch $option {
761	coming {
762	if {[catch {
763	blt::winop snap $itk_component(plotarea) $_image(download)
764	}]} {
765	$_image(download) configure -width 1 -height 1
766	$_image(download) put #000000
767	}
768	}
769	controls {
770	if {![winfo exists $popup]} {
771	# if we haven't created the popup yet, do it now
772	Rappture::Balloon $popup \
773	-title "[Rappture::filexfer::label downloadWord] as..."
774	set inner [$popup component inner]
775	label $inner.summary -text "" -anchor w
776	pack $inner.summary -side top
777	set img $_image(plot)
778	set res "[image width $img]x[image height $img]"
779	radiobutton $inner.draft -text "Image (draft $res)" \
780	-variable Rappture::FlowvisViewer::_downloadPopup(format) \
781	-value draft
782	pack $inner.draft -anchor w
783
784	set res "640x480"
785	radiobutton $inner.medium -text "Movie (standard $res)" \
786	-variable Rappture::FlowvisViewer::_downloadPopup(format) \
787	-value $res
788	pack $inner.medium -anchor w
789
790	set res "1024x768"
791	radiobutton $inner.high -text "Movie (high quality $res)" \
792	-variable Rappture::FlowvisViewer::_downloadPopup(format) \
793	-value $res
794	pack $inner.high -anchor w
795	button $inner.go -text [Rappture::filexfer::label download] \
796	-command [lindex $args 0]
797	pack $inner.go -pady 4
798	$inner.draft select
799	} else {
800	set inner [$popup component inner]
801	}
802	set num [llength [get]]
803	set num [expr {($num == 1) ? "1 result" : "$num results"}]
804	set word [Rappture::filexfer::label downloadWord]
805	$inner.summary configure -text "$word $num in the following format:"
806	update idletasks ;# fix initial sizes
807	return $popup
808	}
809	now {
810	if { [winfo exists $popup] } {
811	$popup deactivate
812	}
813	switch -- $_downloadPopup(format) {
814	draft {
815	# Get the image data (as base64) and decode it back to
816	# binary. This is better than writing to temporary
817	# files. When we switch to the BLT picture image it
818	# won't be necessary to decode the image data.
819	set bytes [$_image(plot) data -format "jpeg -quality 100"]
820	set bytes [Rappture::encoding::decode -as b64 $bytes]
821	return [list .jpg $bytes]
822	}
823	"640x480" {
824	return [$this GetMovie [lindex $args 0] 640 480]
825	}
826	"1024x768" {
827	return [$this GetMovie [lindex $args 0] 1024 768]
828	}
829	default {
830	error "bad download format $_downloadPopup(format)"
831	}
832	}
833	}
834	default {
835	error "bad option \"$option\": should be coming, controls, now"
836	}
837	}
838	}
839
840	# ----------------------------------------------------------------------
841	# USAGE: Connect ?<host:port>,<host:port>...?
842	#
843	# Clients use this method to establish a connection to a new
844	# server, or to reestablish a connection to the previous server.
845	# Any existing connection is automatically closed.
846	# ----------------------------------------------------------------------
847	itcl::body Rappture::FlowvisViewer::Connect {} {
848	set _hosts [GetServerList "nanovis"]
849	if { "" == $_hosts } {
850	return 0
851	}
852	set _reset 1
853	set result [VisViewer::Connect $_hosts]
854	if { $result } {
855	set w [winfo width $itk_component(3dview)]
856	set h [winfo height $itk_component(3dview)]
857	EventuallyResize $w $h
858	}
859	return $result
860	}
861
862	#
863	# isconnected --
864	#
865	# Indicates if we are currently connected to the visualization server.
866	#
867	itcl::body Rappture::FlowvisViewer::isconnected {} {
868	return [VisViewer::IsConnected]
869	}
870
871	#
872	# disconnect --
873	#
874	itcl::body Rappture::FlowvisViewer::disconnect {} {
875	Disconnect
876	}
877
878	#
879	# Disconnect --
880	#
881	# Clients use this method to disconnect from the current rendering
882	# server.
883	#
884	itcl::body Rappture::FlowvisViewer::Disconnect {} {
885	VisViewer::Disconnect
886
887	# disconnected -- no more data sitting on server
888	array unset _serverObjs
889	set _sendobjs ""
890	}
891
892	# ----------------------------------------------------------------------
893	# USAGE: SendDataObjs
894	#
895	# Used internally to send a series of volume objects off to the
896	# server. Sends each object, a little at a time, with updates in
897	# between so the interface doesn't lock up.
898	# ----------------------------------------------------------------------
899	itcl::body Rappture::FlowvisViewer::SendDataObjs {} {
900	blt::busy hold $itk_component(hull)
901	foreach dataobj $_sendobjs {
902	foreach comp [$dataobj components] {
903	# Send the data as one huge base64-encoded mess -- yuck!
904	set data [$dataobj blob $comp]
905	set nbytes [string length $data]
906	set extents [$dataobj extents $comp]
907
908	# I have a field. Is a vector field or a volume field?
909	if { $extents == 1 } {
910	set cmd "volume data follows $nbytes $dataobj-$comp\n"
911	} else {
912	set cmd [FlowCmd $dataobj $comp $nbytes $extents]
913	if { $cmd == "" } {
914	puts stderr "no command"
915	continue
916	}
917	}
918	f { ![SendBytes $cmd] } {
919	puts stderr "can't send"
920	return
921	}
922	if { ![SendBytes $data] } {
923	puts stderr "can't send"
924	return
925	}
926	NameTransferFunc $dataobj $comp
927	set _recvObjs($dataobj-$comp) 1
928	}
929	}
930	set _sendobjs ""
931	blt::busy release $itk_component(hull)
932
933	# Turn on buffering of commands to the server. We don't want to
934	# be preempted by a server disconnect/reconnect (which automatically
935	# generates a new call to Rebuild).
936	StartBufferingCommands
937
938	# activate the proper volume
939	set _first [lindex [get] 0]
940	if { "" != $_first } {
941	set axis [$_first hints updir]
942	if {"" != $axis} {
943	SendCmd "up $axis"
944	}
945
946	if 0 {
947	set location [$_first hints camera]
948	if { $location != "" } {
949	array set _view $location
950	}
951	set _settings($this-qw) $_view(qw)
952	set _settings($this-qx) $_view(qx)
953	set _settings($this-qy) $_view(qy)
954	set _settings($this-qz) $_view(qz)
955	set _settings($this-pan-x) $_view(pan-x)
956	set _settings($this-pan-y) $_view(pan-y)
957	set _settings($this-zoom) $_view(zoom)
958	set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
959	$_arcball quaternion $q
960	SendCmd "camera orient $q"
961	#SendCmd "camera reset"
962	PanCamera
963	SendCmd "camera zoom $_view(zoom)"
964	}
965	# The active transfer function is by default the first component of
966	# the first data object. This assumes that the data is always
967	# successfully transferred.
968	set comp [lindex [$_first components] 0]
969	set _activeTf [lindex $_obj2style($_first-$comp) 0]
970	}
971
972	SendCmd "flow reset"
973	StopBufferingCommands
974	}
975
976	# ----------------------------------------------------------------------
977	# USAGE: SendTransferFuncs
978	# ----------------------------------------------------------------------
979	itcl::body Rappture::FlowvisViewer::SendTransferFuncs {} {
980	if { $_activeTf == "" } {
981	puts stderr "no active tf"
982	return
983	}
984	set tf $_activeTf
985	if { $_first == "" } {
986	puts stderr "no first"
987	return
988	}
989
990	# Ensure that the global opacity and thickness settings (in the slider
991	# settings widgets) are used for the active transfer-function. Update the
992	# values in the _settings varible.
993	set value $_settings($this-opacity)
994	set opacity [expr { double($value) * 0.01 }]
995	set _settings($this-$tf-opacity) $opacity
996	set value $_settings($this-thickness)
997	# Scale values between 0.00001 and 0.01000
998	set thickness [expr {double($value) * 0.0001}]
999	set _settings($this-$tf-thickness) $thickness
1000
1001	foreach key [array names _obj2style $_first-*] {
1002	if { [info exists _obj2style($key)] } {
1003	foreach tf $_obj2style($key) {
1004	ComputeTransferFunc $tf
1005	}
1006	}
1007	}
1008	EventuallyResizeLegend
1009	}
1010
1011	# ----------------------------------------------------------------------
1012	# USAGE: ReceiveImage -bytes $size -type $type -token $token
1013	#
1014	# Invoked automatically whenever the "image" command comes in from
1015	# the rendering server. Indicates that binary image data with the
1016	# specified <size> will follow.
1017	# ----------------------------------------------------------------------
1018	itcl::body Rappture::FlowvisViewer::ReceiveImage { args } {
1019	array set info {
1020	-token "???"
1021	-bytes 0
1022	-type image
1023	}
1024	array set info $args
1025	set bytes [ReceiveBytes $info(-bytes)]
1026	ReceiveEcho <<line "<read $info(-bytes) bytes"
1027	switch -- $info(-type) {
1028	"image" {
1029	$_image(plot) configure -data $bytes
1030	#puts stderr "image received [image width $_image(plot)] by [image height $_image(plot)]"
1031	}
1032	"print" {
1033	set tag $this-$info(-token)
1034	set _hardcopy($tag) $bytes
1035	}
1036	"movie" {
1037	set tag $this-$info(-token)
1038	set _hardcopy($tag) $bytes
1039	}
1040	default {
1041	puts stderr "unknown download type $info(-type)"
1042	}
1043	}
1044	}
1045
1046	#
1047	# ReceiveLegend --
1048	#
1049	# The procedure is the response from the render server to each "legend"
1050	# command. The server sends back a "legend" command invoked our
1051	# the slave interpreter. The purpose is to collect data of the image
1052	# representing the legend in the canvas. In addition, the isomarkers
1053	# of the active transfer function are displayed.
1054	#
1055	# I don't know is this is the right place to display the isomarkers.
1056	# I don't know all the different paths used to draw the plot. There's
1057	# "Rebuild", "add", etc.
1058	#
1059	itcl::body Rappture::FlowvisViewer::ReceiveLegend { tag vmin vmax size } {
1060	if { ![isconnected] } {
1061	return
1062	}
1063	#puts stderr "receive legend $tag $vmin $vmax $size"
1064	set bytes [ReceiveBytes $size]
1065	$_image(legend) configure -data $bytes
1066	ReceiveEcho <<line "<read $size bytes for [image width $_image(legend)]x[image height $_image(legend)] legend>"
1067
1068	set c $itk_component(legend)
1069	set w [winfo width $c]
1070	set h [winfo height $c]
1071	set lx 10
1072	# FIXME: I don't know what I have to do this for the 2D flow
1073	# example. Otherwise the canvas background is white.
1074	# I'll get to this when we add background changes into
1075	# nanvis.
1076	$c configure -background black
1077	set ly [expr {$h - 1}]
1078	if {"" == [$c find withtag transfunc]} {
1079	$c create image 10 10 -anchor nw \
1080	-image $_image(legend) -tags transfunc
1081	$c create text $lx $ly -anchor sw \
1082	-fill $itk_option(-plotforeground) -tags "limits vmin"
1083	$c create text [expr {$w-$lx}] $ly -anchor se \
1084	-fill $itk_option(-plotforeground) -tags "limits vmax"
1085	$c lower transfunc
1086	$c bind transfunc <ButtonRelease-1> \
1087	[itcl::code $this AddIsoMarker %x %y]
1088	}
1089	# Display the markers used by the active transfer function.
1090	set tf $_obj2style($tag)
1091	array set limits [limits $tf]
1092	$c itemconfigure vmin -text [format %.2g $limits(vmin)]
1093	$c coords vmin $lx $ly
1094
1095	$c itemconfigure vmax -text [format %.2g $limits(vmax)]
1096	$c coords vmax [expr {$w-$lx}] $ly
1097
1098	if { [info exists _isomarkers($tf)] } {
1099	foreach m $_isomarkers($tf) {
1100	$m visible yes
1101	}
1102	}
1103	}
1104
1105	#
1106	# ReceiveData --
1107	#
1108	# The procedure is the response from the render server to each "data
1109	# follows" command. The server sends back a "data" command invoked our
1110	# the slave interpreter. The purpose is to collect the min/max of the
1111	# volume sent to the render server. Since the client (flowvisviewer)
1112	# doesn't parse 3D data formats, we rely on the server (flowvis) to
1113	# tell us what the limits are. Once we've received the limits to all
1114	# the data we've sent (tracked by _recvObjs) we can then determine
1115	# what the transfer functions are for these # volumes.
1116	#
1117	# Note: There is a considerable tradeoff in having the server report
1118	# back what the data limits are. It means that much of the code
1119	# having to do with transfer-functions has to wait for the data
1120	# to come back, since the isomarkers are calculated based upon
1121	# the data limits. The client code is much messier because of
1122	# this. The alternative is to parse any of the 3D formats on the
1123	# client side.
1124	#
1125	itcl::body Rappture::FlowvisViewer::ReceiveData { args } {
1126	if { ![isconnected] } {
1127	return
1128	}
1129	# Arguments from server are name value pairs. Stuff them in an array.
1130	array set values $args
1131	set tag $values(tag)
1132	set parts [split $tag -]
1133	set dataobj [lindex $parts 0]
1134	set _serverObjs($tag) 0
1135	set _limits($tag-min) $values(min); # Minimum value of the volume.
1136	set _limits($tag-max) $values(max); # Maximum value of the volume.
1137	unset _recvObjs($tag)
1138	if { [array size _recvObjs] == 0 } {
1139	updatetransferfuncs
1140	}
1141	}
1142
1143	#
1144	# Rebuild --
1145	#
1146	# Called automatically whenever something changes that affects the data
1147	# in the widget. Clears any existing data and rebuilds the widget to
1148	# display new data.
1149	#
1150	itcl::body Rappture::FlowvisViewer::Rebuild {} {
1151
1152	# Hide all the isomarkers. Can't remove them. Have to remember the
1153	# settings since the user may have created/deleted/moved markers.
1154
1155	foreach tf [array names _isomarkers] {
1156	foreach m $_isomarkers($tf) {
1157	$m visible no
1158	}
1159	}
1160
1161	set _first ""
1162	# Turn on buffering of commands to the server. We don't want to
1163	# be preempted by a server disconnect/reconnect (which automatically
1164	# generates a new call to Rebuild).
1165	StartBufferingCommands
1166
1167	if { $_reset } {
1168	if { $_reportClientInfo } {
1169	# Tell the server the name of the tool, the version, and
1170	# dataset that we are rendering. Have to do it here because
1171	# we don't know what data objects are using the renderer until
1172	# be get here.
1173	global env
1174
1175	set info {}
1176	set user "???"
1177	if { [info exists env(USER)] } {
1178	set user $env(USER)
1179	}
1180	set session "???"
1181	if { [info exists env(SESSION)] } {
1182	set session $env(SESSION)
1183	}
1184	lappend info "hub" [exec hostname]
1185	lappend info "client" "flowvisviewer"
1186	lappend info "user" $user
1187	lappend info "session" $session
1188	SendCmd "clientinfo [list $info]"
1189	}
1190	set _width [winfo width $itk_component(3dview)]
1191	set _height [winfo height $itk_component(3dview)]
1192	Resize
1193	}
1194	foreach dataobj [get] {
1195	foreach comp [$dataobj components] {
1196	set tag $dataobj-$comp
1197	# Send the data as one huge base64-encoded mess -- yuck!
1198	set data [$dataobj blob $comp]
1199	set nbytes [string length $data]
1200	if { $_reportClientInfo } {
1201	set info {}
1202	lappend info "tool_id" [$dataobj hints toolId]
1203	lappend info "tool_name" [$dataobj hints toolName]
1204	lappend info "tool_version" [$dataobj hints toolRevision]
1205	lappend info "tool_title" [$dataobj hints toolTitle]
1206	lappend info "dataset_label" [$dataobj hints label]
1207	lappend info "dataset_size" $nbytes
1208	lappend info "dataset_tag" $tag
1209	SendCmd "clientinfo [list $info]"
1210	}
1211	set extents [$dataobj extents $comp]
1212	# I have a field. Is a vector field or a volume field?
1213	if { $extents == 1 } {
1214	set cmd "volume data follows $nbytes $tag\n"
1215	} else {
1216	set cmd [FlowCmd $dataobj $comp $nbytes $extents]
1217	if { $cmd == "" } {
1218	puts stderr "no command"
1219	continue
1220	}
1221	}
1222	append _outbuf $cmd
1223	append _outbuf $data
1224	NameTransferFunc $dataobj $comp
1225	set _recvObjs($tag) 1
1226	}
1227	}
1228
1229	set _first [lindex [get] 0]
1230
1231	# Reset the camera and other view parameters
1232	InitSettings isosurface grid axes volume outline light2side light transp
1233
1234	# nothing to send -- activate the proper volume
1235	if {"" != $_first} {
1236	AdjustSetting light
1237	AdjustSetting transp
1238	set axis [$_first hints updir]
1239	if {"" != $axis} {
1240	SendCmd "up $axis"
1241	}
1242	set location [$_first hints camera]
1243	if { $location != "" } {
1244	array set _view $location
1245	}
1246
1247	}
1248	set _settings($this-qw) $_view(qw)
1249	set _settings($this-qx) $_view(qx)
1250	set _settings($this-qy) $_view(qy)
1251	set _settings($this-qz) $_view(qz)
1252	set _settings($this-pan-x) $_view(pan-x)
1253	set _settings($this-pan-y) $_view(pan-y)
1254	set _settings($this-zoom) $_view(zoom)
1255
1256	set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1257	$_arcball quaternion $q
1258	SendCmd "camera orient $q"
1259	#SendCmd "camera reset"
1260	PanCamera
1261	SendCmd "camera zoom $_view(zoom)"
1262
1263	foreach dataobj [get] {
1264	foreach comp [$dataobj components] {
1265	NameTransferFunc $dataobj $comp
1266	}
1267	}
1268
1269	# nothing to send -- activate the proper ivol
1270	set _first [lindex [get] 0]
1271	if {"" != $_first} {
1272	set axis [$_first hints updir]
1273	if {"" != $axis} {
1274	SendCmd "up $axis"
1275	}
1276	set location [$_first hints camera]
1277	if { $location != "" } {
1278	array set _view $location
1279	}
1280	set comp [lindex [$_first components] 0]
1281	set _activeTf [lindex $_obj2style($_first-$comp) 0]
1282	}
1283
1284
1285	# sync the state of slicers
1286	set vols [CurrentVolumeIds -cutplanes]
1287	foreach axis {x y z} {
1288	SendCmd "cutplane state $_settings($this-${axis}cutplane) $axis $vols"
1289	set pos [expr {0.01*$_settings($this-${axis}cutposition)}]
1290	SendCmd "cutplane position $pos $axis $vols"
1291	}
1292	SendCmd "volume data state $_settings($this-volume)"
1293	EventuallyResizeLegend
1294
1295	# Actually write the commands to the server socket. If it fails, we don't
1296	# care. We're finished here.
1297	blt::busy hold $itk_component(hull)
1298	StopBufferingCommands
1299	blt::busy release $itk_component(hull)
1300	set _reset 0
1301	}
1302
1303	# ----------------------------------------------------------------------
1304	# USAGE: CurrentVolumeIds ?-cutplanes?
1305	#
1306	# Returns a list of volume server IDs for the current volume being
1307	# displayed. This is normally a single ID, but it might be a list
1308	# of IDs if the current data object has multiple components.
1309	# ----------------------------------------------------------------------
1310	itcl::body Rappture::FlowvisViewer::CurrentVolumeIds {{what -all}} {
1311	return ""
1312	if { $_first == "" } {
1313	return
1314	}
1315	foreach key [array names _serverObjs -] {
1316	if {[string match $_first-* $key]} {
1317	array set style {
1318	-cutplanes 1
1319	}
1320	foreach {dataobj comp} [split $key -] break
1321	array set style [lindex [$dataobj components -style $comp] 0]
1322	if {$what != "-cutplanes" \|\| $style(-cutplanes)} {
1323	lappend rlist $_serverObjs($key)
1324	}
1325	}
1326	}
1327	return $rlist
1328	}
1329
1330	# ----------------------------------------------------------------------
1331	# USAGE: Zoom in
1332	# USAGE: Zoom out
1333	# USAGE: Zoom reset
1334	#
1335	# Called automatically when the user clicks on one of the zoom
1336	# controls for this widget. Changes the zoom for the current view.
1337	# ----------------------------------------------------------------------
1338	itcl::body Rappture::FlowvisViewer::Zoom {option} {
1339	switch -- $option {
1340	"in" {
1341	set _view(zoom) [expr {$_view(zoom)*1.25}]
1342	set _settings($this-zoom) $_view(zoom)
1343	SendCmd "camera zoom $_view(zoom)"
1344	}
1345	"out" {
1346	set _view(zoom) [expr {$_view(zoom)*0.8}]
1347	set _settings($this-zoom) $_view(zoom)
1348	SendCmd "camera zoom $_view(zoom)"
1349	}
1350	"reset" {
1351	array set _view {
1352	qw 0.853553
1353	qx -0.353553
1354	qy 0.353553
1355	qz 0.146447
1356	zoom 1.0
1357	pan-x 0
1358	pan-y 0
1359	}
1360	if { $_first != "" } {
1361	set location [$_first hints camera]
1362	if { $location != "" } {
1363	array set _view $location
1364	}
1365	}
1366	set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
1367	$_arcball quaternion $q
1368	SendCmd "camera orient $q"
1369	#SendCmd "camera reset"
1370	SendCmd "camera zoom $_view(zoom)"
1371	set _settings($this-qw) $_view(qw)
1372	set _settings($this-qx) $_view(qx)
1373	set _settings($this-qy) $_view(qy)
1374	set _settings($this-qz) $_view(qz)
1375	set _settings($this-pan-x) $_view(pan-x)
1376	set _settings($this-pan-y) $_view(pan-y)
1377	set _settings($this-zoom) $_view(zoom)
1378	}
1379	}
1380	}
1381
1382	itcl::body Rappture::FlowvisViewer::PanCamera {} {
1383	#set x [expr ($_view(pan-x)) / $_limits(xrange)]
1384	#set y [expr ($_view(pan-y)) / $_limits(yrange)]
1385	set x $_view(pan-x)
1386	set y $_view(pan-y)
1387	SendCmd "camera pan $x $y"
1388	}
1389
1390	# ----------------------------------------------------------------------
1391	# USAGE: Rotate click <x> <y>
1392	# USAGE: Rotate drag <x> <y>
1393	# USAGE: Rotate release <x> <y>
1394	#
1395	# Called automatically when the user clicks/drags/releases in the
1396	# plot area. Moves the plot according to the user's actions.
1397	# ----------------------------------------------------------------------
1398	itcl::body Rappture::FlowvisViewer::Rotate {option x y} {
1399	switch -- $option {
1400	click {
1401	$itk_component(3dview) configure -cursor fleur
1402	set _click(x) $x
1403	set _click(y) $y
1404	}
1405	drag {
1406	if {[array size _click] == 0} {
1407	Rotate click $x $y
1408	} else {
1409	set w [winfo width $itk_component(3dview)]
1410	set h [winfo height $itk_component(3dview)]
1411	if {$w <= 0 \|\| $h <= 0} {
1412	return
1413	}
1414
1415	if {[catch {
1416	# this fails sometimes for no apparent reason
1417	set dx [expr {double($x-$_click(x))/$w}]
1418	set dy [expr {double($y-$_click(y))/$h}]
1419	}]} {
1420	return
1421	}
1422
1423	set q [$_arcball rotate $x $y $_click(x) $_click(y)]
1424	foreach { _view(qw) _view(qx) _view(qy) _view(qz) } $q break
1425	set _settings($this-qw) $_view(qw)
1426	set _settings($this-qx) $_view(qx)
1427	set _settings($this-qy) $_view(qy)
1428	set _settings($this-qz) $_view(qz)
1429	SendCmd "camera orient $q"
1430
1431	set _click(x) $x
1432	set _click(y) $y
1433	}
1434	}
1435	release {
1436	Rotate drag $x $y
1437	$itk_component(3dview) configure -cursor ""
1438	catch {unset _click}
1439	}
1440	default {
1441	error "bad option \"$option\": should be click, drag, release"
1442	}
1443	}
1444	}
1445
1446	# ----------------------------------------------------------------------
1447	# USAGE: $this Pan click x y
1448	# $this Pan drag x y
1449	# $this Pan release x y
1450	#
1451	# Called automatically when the user clicks on one of the zoom
1452	# controls for this widget. Changes the zoom for the current view.
1453	# ----------------------------------------------------------------------
1454	itcl::body Rappture::FlowvisViewer::Pan {option x y} {
1455	# Experimental stuff
1456	set w [winfo width $itk_component(3dview)]
1457	set h [winfo height $itk_component(3dview)]
1458	if { $option == "set" } {
1459	set x [expr $x / double($w)]
1460	set y [expr $y / double($h)]
1461	set _view(pan-x) [expr $_view(pan-x) + $x]
1462	set _view(pan-y) [expr $_view(pan-y) + $y]
1463	PanCamera
1464	set _settings($this-pan-x) $_view(pan-x)
1465	set _settings($this-pan-y) $_view(pan-y)
1466	return
1467	}
1468	if { $option == "click" } {
1469	set _click(x) $x
1470	set _click(y) $y
1471	$itk_component(3dview) configure -cursor hand1
1472	}
1473	if { $option == "drag" \|\| $option == "release" } {
1474	set dx [expr ($_click(x) - $x)/double($w)]
1475	set dy [expr ($_click(y) - $y)/double($h)]
1476	set _click(x) $x
1477	set _click(y) $y
1478	set _view(pan-x) [expr $_view(pan-x) - $dx]
1479	set _view(pan-y) [expr $_view(pan-y) - $dy]
1480	PanCamera
1481	set _settings($this-pan-x) $_view(pan-x)
1482	set _settings($this-pan-y) $_view(pan-y)
1483	}
1484	if { $option == "release" } {
1485	$itk_component(3dview) configure -cursor ""
1486	}
1487	}
1488
1489
1490	# ----------------------------------------------------------------------
1491	# USAGE: Flow movie record\|stop\|play ?on\|off\|toggle?
1492	#
1493	# Called when the user clicks on the record, stop or play buttons
1494	# for flow visualization.
1495	# ----------------------------------------------------------------------
1496	itcl::body Rappture::FlowvisViewer::Flow {option args} {
1497	switch -- $option {
1498	movie {
1499	if {[llength $args] < 1 \|\| [llength $args] > 2} {
1500	error "wrong # args: should be \"Flow movie record\|stop\|play ?on\|off\|toggle?\""
1501	}
1502	set action [lindex $args 0]
1503	set op [lindex $args 1]
1504	if {$op == ""} { set op "on" }
1505
1506	set current [State $action]
1507	if {$op == "toggle"} {
1508	if {$current == "on"} {
1509	set op "off"
1510	} else {
1511	set op "on"
1512	}
1513	}
1514	set cmds ""
1515	switch -- $action {
1516	record {
1517	if { [$itk_component(rewind) cget -relief] != "sunken" } {
1518	$itk_component(rewind) configure -relief sunken
1519	$itk_component(stop) configure -relief raised
1520	$itk_component(play) configure -relief raised
1521	set inner $itk_component(settingsFrame)
1522	set frames [$inner.framecnt value]
1523	set _settings(nsteps) $frames
1524	set cmds "flow capture $frames"
1525	SendCmd $cmds
1526	}
1527	}
1528	stop {
1529	if { [$itk_component(stop) cget -relief] != "sunken" } {
1530	$itk_component(rewind) configure -relief raised
1531	$itk_component(stop) configure -relief sunken
1532	$itk_component(play) configure -relief raised
1533	_pause
1534	set cmds "flow reset"
1535	SendCmd $cmds
1536	}
1537	}
1538	play {
1539	if { [$itk_component(play) cget -relief] != "sunken" } {
1540	$itk_component(rewind) configure -relief raised
1541	$itk_component(stop) configure -relief raised
1542	$itk_component(play) configure \
1543	-image [Rappture::icon flow-pause] \
1544	-relief sunken
1545	bind $itk_component(play) <ButtonPress> \
1546	[itcl::code $this _pause]
1547	flow next
1548	}
1549	}
1550	default {
1551	error "bad option \"$option\": should be one of record\|stop\|play"
1552	}
1553
1554	}
1555	}
1556	default {
1557	error "bad option \"$option\": should be movie"
1558	}
1559	}
1560	}
1561
1562	# ----------------------------------------------------------------------
1563	# USAGE: Play
1564	#
1565	# ----------------------------------------------------------------------
1566	itcl::body Rappture::FlowvisViewer::Play {} {
1567	SendCmd "flow next"
1568	set delay [expr {int(ceil(pow($_settings(speed)/10.0+2,2.0)*15))}]
1569	$_dispatcher event -after $delay !play
1570	}
1571
1572	# ----------------------------------------------------------------------
1573	# USAGE: Pause
1574	#
1575	# Invoked when the user hits the "pause" button to stop playing the
1576	# current sequence of frames as a movie.
1577	# ----------------------------------------------------------------------
1578	itcl::body Rappture::FlowvisViewer::Pause {} {
1579	$_dispatcher cancel !play
1580
1581	# Toggle the button to "play" mode
1582	$itk_component(play) configure \
1583	-image [Rappture::icon flow-start] \
1584	-relief raised
1585	bind $itk_component(play) <ButtonPress> \
1586	[itcl::code $this Flow movie play toggle]
1587	}
1588
1589	# ----------------------------------------------------------------------
1590	# USAGE: InitSettings <what> ?<value>?
1591	#
1592	# Used internally to update rendering settings whenever parameters
1593	# change in the popup settings panel. Sends the new settings off
1594	# to the back end.
1595	# ----------------------------------------------------------------------
1596	itcl::body Rappture::FlowvisViewer::InitSettings { args } {
1597	foreach arg $args {
1598	AdjustSetting $arg
1599	}
1600	}
1601
1602	# ----------------------------------------------------------------------
1603	# USAGE: AdjustSetting <what> ?<value>?
1604	#
1605	# Used internally to update rendering settings whenever parameters
1606	# change in the popup settings panel. Sends the new settings off
1607	# to the back end.
1608	# ----------------------------------------------------------------------
1609	itcl::body Rappture::FlowvisViewer::AdjustSetting {what {value ""}} {
1610	switch -- $what {
1611	colormap {
1612	set color [$itk_component(colormap) value]
1613	set _settings(colormap) $color
1614	#ResetColormap $color
1615	}
1616	light {
1617	if { $_first != "" } {
1618	set comp [lindex [$_first components] 0]
1619	set tag $_first-$comp
1620	set diffuse [expr {0.01*$_settings($this-light)}]
1621	set ambient [expr {1.0 - $diffuse}]
1622	set specularLevel 0.3
1623	set specularExp 90.0
1624	SendCmd "$tag configure -ambient $ambient -diffuse $diffuse -specularLevel $specularLevel -specularExp $specularExp"
1625	}
1626	}
1627	light2side {
1628	if { $_first != "" } {
1629	set comp [lindex [$_first components] 0]
1630	set tag $_first-$comp
1631	set val $_settings($this-light2side)
1632	SendCmd "$tag configure -light2side $val"
1633	}
1634	}
1635	transp {
1636	if { $_first != "" } {
1637	set comp [lindex [$_first components] 0]
1638	set tag $_first-$comp
1639	set opacity [expr { 0.01 * double($_settings($this-transp)) }]
1640	SendCmd "$tag configure -opacity $opacity"
1641	}
1642	}
1643	opacity {
1644	if { $_first != "" && $_activeTf != "" } {
1645	set opacity [expr { 0.01 * double($_settings($this-opacity)) }]
1646	set tf $_activeTf
1647	set _settings($this-$tf-opacity) $opacity
1648	updatetransferfuncs
1649	}
1650	}
1651
1652	thickness {
1653	if { $_first != "" && $_activeTf != "" } {
1654	set val $_settings($this-thickness)
1655	# Scale values between 0.00001 and 0.01000
1656	set sval [expr {0.0001*double($val)}]
1657	set tf $_activeTf
1658	set _settings($this-$tf-thickness) $sval
1659	updatetransferfuncs
1660	}
1661	}
1662	"outline" {
1663	if { $_first != "" } {
1664	set comp [lindex [$_first components] 0]
1665	set tag $_first-$comp
1666	SendCmd "$tag configure -outline $_settings($this-outline)"
1667	}
1668	}
1669	"isosurface" {
1670	if { [isconnected] } {
1671	SendCmd "volume shading isosurface $_settings($this-isosurface)"
1672	}
1673	}
1674	"grid" {
1675	if { [isconnected] } {
1676	SendCmd "grid visible $_settings($this-grid)"
1677	}
1678	}
1679	"axes" {
1680	if { [isconnected] } {
1681	SendCmd "axis visible $_settings($this-axes)"
1682	}
1683	}
1684	"legend" {
1685	if { $_settings($this-legend) } {
1686	blt::table $itk_component(plotarea) \
1687	0,0 $itk_component(3dview) -fill both \
1688	1,0 $itk_component(legend) -fill x
1689	blt::table configure $itk_component(plotarea) r1 -resize none
1690	} else {
1691	blt::table forget $itk_component(legend)
1692	}
1693	}
1694	"volume" {
1695	if { $_first != "" } {
1696	set comp [lindex [$_first components] 0]
1697	set tag $_first-$comp
1698	SendCmd "$tag configure -volume $_settings($this-volume)"
1699	}
1700	}
1701	"xcutplane" - "ycutplane" - "zcutplane" {
1702	set axis [string range $what 0 0]
1703	set bool $_settings($this-$what)
1704	if { [isconnected] } {
1705	set vols [CurrentVolumeIds -cutplanes]
1706	SendCmd "cutplane state $bool $axis $vols"
1707	}
1708	if { $bool } {
1709	$itk_component(${axis}CutScale) configure -state normal \
1710	-troughcolor white
1711	} else {
1712	$itk_component(${axis}CutScale) configure -state disabled \
1713	-troughcolor grey82
1714	}
1715	}
1716	default {
1717	error "don't know how to fix $what"
1718	}
1719	}
1720	}
1721
1722	# ----------------------------------------------------------------------
1723	# USAGE: ResizeLegend
1724	#
1725	# Used internally to update the legend area whenever it changes size
1726	# or when the field changes. Asks the server to send a new legend
1727	# for the current field.
1728	# ----------------------------------------------------------------------
1729	itcl::body Rappture::FlowvisViewer::ResizeLegend {} {
1730	set _resizeLegendPending 0
1731	set lineht [font metrics $itk_option(-font) -linespace]
1732	set w [expr {$_width-20}]
1733	set h [expr {[winfo height $itk_component(legend)]-20-$lineht}]
1734
1735	if { $_first == "" } {
1736	return
1737	}
1738	set comp [lindex [$_first components] 0]
1739	set tag $_first-$comp
1740	#set _activeTf [lindex $_obj2style($tag) 0]
1741	if {$w > 0 && $h > 0 && "" != $_activeTf} {
1742	#SendCmd "legend $_activeTf $w $h"
1743	SendCmd "$tag legend $w $h"
1744	} else {
1745	# Can't do this as this will remove the items associated with the
1746	# isomarkers.
1747
1748	#$itk_component(legend) delete all
1749	}
1750	}
1751
1752	#
1753	# NameTransferFunc --
1754	#
1755	# Creates a transfer function name based on the <style> settings in the
1756	# library run.xml file. This placeholder will be used later to create
1757	# and send the actual transfer function once the data info has been sent
1758	# to us by the render server. [We won't know the volume limits until the
1759	# server parses the 3D data and sends back the limits via ReceiveData.]
1760	#
1761	# FIXME: The current way we generate transfer-function names completely
1762	# ignores the -markers option. The problem is that we are forced
1763	# to compute the name from an increasing complex set of values:
1764	# color, levels, marker, opacity. I think we're stuck doing it
1765	# now.
1766	#
1767	itcl::body Rappture::FlowvisViewer::NameTransferFunc { dataobj comp } {
1768	array set style {
1769	-color BCGYR
1770	-levels 6
1771	-opacity 1.0
1772	-light 40
1773	-transp 50
1774	}
1775	array set style [lindex [$dataobj components -style $comp] 0]
1776	set _settings($this-light) $style(-light)
1777	set _settings($this-transp) $style(-transp)
1778	set _settings($this-opacity) [expr $style(-opacity) * 100]
1779	set tf "$style(-color):$style(-levels):$style(-opacity)"
1780	set _obj2style($dataobj-$comp) $tf
1781	lappend _style2objs($tf) $dataobj $comp
1782	return $tf
1783	}
1784
1785	#
1786	# ComputeTransferFunc --
1787	#
1788	# Computes and sends the transfer function to the render server. It's
1789	# assumed that the volume data limits are known and that the global
1790	# transfer-functions slider values have be setup. Both parts are
1791	# needed to compute the relative value (location) of the marker, and
1792	# the alpha map of the transfer function.
1793	#
1794	itcl::body Rappture::FlowvisViewer::ComputeTransferFunc { tf } {
1795	array set style {
1796	-color BCGYR
1797	-levels 6
1798	-opacity 1.0
1799	-light 40
1800	-transp 50
1801	}
1802	set dataobj ""; set comp ""
1803	foreach {dataobj comp} $_style2objs($tf) break
1804	if { $dataobj == "" } {
1805	return 0
1806	}
1807	array set style [lindex [$dataobj components -style $comp] 0]
1808
1809
1810	# We have to parse the style attributes for a volume using this
1811	# transfer-function once. This sets up the initial isomarkers for the
1812	# transfer function. The user may add/delete markers, so we have to
1813	# maintain a list of markers for each transfer-function. We use the one
1814	# of the volumes (the first in the list) using the transfer-function as a
1815	# reference.
1816	#
1817	# FIXME: The current way we generate transfer-function names completely
1818	# ignores the -markers option. The problem is that we are forced
1819	# to compute the name from an increasing complex set of values:
1820	# color, levels, marker, opacity. I think the cow's out of the
1821	# barn on this one.
1822
1823	if { ![info exists _isomarkers($tf)] } {
1824	# Have to defer creation of isomarkers until we have data limits
1825	if { [info exists style(-markers)] &&
1826	[llength $style(-markers)] > 0 } {
1827	ParseMarkersOption $tf $style(-markers)
1828	} else {
1829	ParseLevelsOption $tf $style(-levels)
1830	}
1831	}
1832	if { [info exists style(-nonuniformcolors)] } {
1833	foreach { value color } $style(-nonuniformcolors) {
1834	append cmap "$value [Color2RGB $color] "
1835	}
1836	} else {
1837	set cmap [ColorsToColormap $style(-color)]
1838	}
1839	set tag $this-$tf
1840	if { ![info exists _settings($tag-opacity)] } {
1841	set _settings($tag-opacity) $style(-opacity)
1842	}
1843	set max 1.0 ;#$_settings($tag-opacity)
1844
1845	set isovalues {}
1846	foreach m $_isomarkers($tf) {
1847	lappend isovalues [$m relval]
1848	}
1849	# Sort the isovalues
1850	set isovalues [lsort -real $isovalues]
1851
1852	if { ![info exists _settings($tag-thickness)]} {
1853	set _settings($tag-thickness) 0.005
1854	}
1855	set delta $_settings($tag-thickness)
1856
1857	set first [lindex $isovalues 0]
1858	set last [lindex $isovalues end]
1859	set wmap ""
1860	if { $first == "" \|\| $first != 0.0 } {
1861	lappend wmap 0.0 0.0
1862	}
1863	foreach x $isovalues {
1864	set x1 [expr {$x-$delta-0.00001}]
1865	set x2 [expr {$x-$delta}]
1866	set x3 [expr {$x+$delta}]
1867	set x4 [expr {$x+$delta+0.00001}]
1868	if { $x1 < 0.0 } {
1869	set x1 0.0
1870	} elseif { $x1 > 1.0 } {
1871	set x1 1.0
1872	}
1873	if { $x2 < 0.0 } {
1874	set x2 0.0
1875	} elseif { $x2 > 1.0 } {
1876	set x2 1.0
1877	}
1878	if { $x3 < 0.0 } {
1879	set x3 0.0
1880	} elseif { $x3 > 1.0 } {
1881	set x3 1.0
1882	}
1883	if { $x4 < 0.0 } {
1884	set x4 0.0
1885	} elseif { $x4 > 1.0 } {
1886	set x4 1.0
1887	}
1888	# add spikes in the middle
1889	lappend wmap $x1 0.0
1890	lappend wmap $x2 $max
1891	lappend wmap $x3 $max
1892	lappend wmap $x4 0.0
1893	}
1894	if { $last == "" \|\| $last != 1.0 } {
1895	lappend wmap 1.0 0.0
1896	}
1897	SendCmd "transfunc define $tf { $cmap } { $wmap }"
1898	return [SendCmd "$dataobj-$comp configure -transferfunction $tf"]
1899	}
1900
1901	# ----------------------------------------------------------------------
1902	# CONFIGURATION OPTION: -plotbackground
1903	# ----------------------------------------------------------------------
1904	itcl::configbody Rappture::FlowvisViewer::plotbackground {
1905	if { [isconnected] } {
1906	foreach {r g b} [Color2RGB $itk_option(-plotbackground)] break
1907	#fix this!
1908	#SendCmd "color background $r $g $b"
1909	}
1910	}
1911
1912	# ----------------------------------------------------------------------
1913	# CONFIGURATION OPTION: -plotforeground
1914	# ----------------------------------------------------------------------
1915	itcl::configbody Rappture::FlowvisViewer::plotforeground {
1916	if { [isconnected] } {
1917	foreach {r g b} [Color2RGB $itk_option(-plotforeground)] break
1918	#fix this!
1919	#SendCmd "color background $r $g $b"
1920	}
1921	}
1922
1923	# ----------------------------------------------------------------------
1924	# CONFIGURATION OPTION: -plotoutline
1925	# ----------------------------------------------------------------------
1926	itcl::configbody Rappture::FlowvisViewer::plotoutline {
1927	# Must check if we are connected because this routine is called from the
1928	# class body when the -plotoutline itk_option is defined. At that point
1929	# the FlowvisViewer class constructor hasn't been called, so we can't
1930	# start sending commands to visualization server.
1931	if { [isconnected] } {
1932	if {"" == $itk_option(-plotoutline)} {
1933	SendCmd "volume outline state off"
1934	} else {
1935	SendCmd "volume outline state on"
1936	SendCmd "volume outline color [Color2RGB $itk_option(-plotoutline)]"
1937	}
1938	}
1939	}
1940
1941	#
1942	# The -levels option takes a single value that represents the number
1943	# of evenly distributed markers based on the current data range. Each
1944	# marker is a relative value from 0.0 to 1.0.
1945	#
1946	itcl::body Rappture::FlowvisViewer::ParseLevelsOption { tf levels } {
1947	set c $itk_component(legend)
1948	regsub -all "," $levels " " levels
1949	if {[string is int $levels]} {
1950	for {set i 1} { $i <= $levels } {incr i} {
1951	set x [expr {double($i)/($levels+1)}]
1952	set m [Rappture::IsoMarker \#auto $c $this $tf]
1953	$m relval $x
1954	lappend _isomarkers($tf) $m
1955	}
1956	} else {
1957	foreach x $levels {
1958	set m [Rappture::IsoMarker \#auto $c $this $tf]
1959	$m relval $x
1960	lappend _isomarkers($tf) $m
1961	}
1962	}
1963	}
1964
1965	#
1966	# The -markers option takes a list of zero or more values (the values
1967	# may be separated either by spaces or commas) that have the following
1968	# format:
1969	#
1970	# N% Percent of current total data range. Converted to
1971	# to a relative value between 0.0 and 1.0.
1972	# N Absolute value of marker. If the marker is outside of
1973	# the current range, it will be displayed on the outer
1974	# edge of the legends, but it range it represents will
1975	# not be seen.
1976	#
1977	itcl::body Rappture::FlowvisViewer::ParseMarkersOption { tf markers } {
1978	set c $itk_component(legend)
1979	regsub -all "," $markers " " markers
1980	foreach marker $markers {
1981	set n [scan $marker "%g%s" value suffix]
1982	if { $n == 2 && $suffix == "%" } {
1983	# ${n}% : Set relative value.
1984	set value [expr {$value * 0.01}]
1985	set m [Rappture::IsoMarker \#auto $c $this $tf]
1986	$m relval $value
1987	lappend _isomarkers($tf) $m
1988	} else {
1989	# ${n} : Set absolute value.
1990	set m [Rappture::IsoMarker \#auto $c $this $tf]
1991	$m absval $value
1992	lappend _isomarkers($tf) $m
1993	}
1994	}
1995	}
1996
1997	# ----------------------------------------------------------------------
1998	# USAGE: UndateTransferFuncs
1999	# ----------------------------------------------------------------------
2000	itcl::body Rappture::FlowvisViewer::updatetransferfuncs {} {
2001	$_dispatcher event -after 100 !send_transfunc
2002	}
2003
2004	itcl::body Rappture::FlowvisViewer::AddIsoMarker { x y } {
2005	if { $_activeTf == "" } {
2006	error "active transfer function isn't set"
2007	}
2008	set tf $_activeTf
2009	set c $itk_component(legend)
2010	set m [Rappture::IsoMarker \#auto $c $this $tf]
2011	set w [winfo width $c]
2012	$m relval [expr {double($x-10)/($w-20)}]
2013	lappend _isomarkers($tf) $m
2014	updatetransferfuncs
2015	return 1
2016	}
2017
2018	itcl::body Rappture::FlowvisViewer::rmdupmarker { marker x } {
2019	set tf [$marker transferfunc]
2020	set bool 0
2021	if { [info exists _isomarkers($tf)] } {
2022	set list {}
2023	set marker [namespace tail $marker]
2024	foreach m $_isomarkers($tf) {
2025	set sx [$m screenpos]
2026	if { $m != $marker } {
2027	if { $x >= ($sx-3) && $x <= ($sx+3) } {
2028	$marker relval [$m relval]
2029	itcl::delete object $m
2030	bell
2031	set bool 1
2032	continue
2033	}
2034	}
2035	lappend list $m
2036	}
2037	set _isomarkers($tf) $list
2038	updatetransferfuncs
2039	}
2040	return $bool
2041	}
2042
2043	itcl::body Rappture::FlowvisViewer::overmarker { marker x } {
2044	set tf [$marker transferfunc]
2045	if { [info exists _isomarkers($tf)] } {
2046	set marker [namespace tail $marker]
2047	foreach m $_isomarkers($tf) {
2048	set sx [$m screenpos]
2049	if { $m != $marker } {
2050	set bool [expr { $x >= ($sx-3) && $x <= ($sx+3) }]
2051	$m activate $bool
2052	}
2053	}
2054	}
2055	return ""
2056	}
2057
2058	itcl::body Rappture::FlowvisViewer::limits { tf } {
2059	set _limits(vmin) 0.0
2060	set _limits(vmax) 1.0
2061	if { ![info exists _style2objs($tf)] } {
2062	puts stderr "no style2objs for $tf tf=($tf)"
2063	return [array get _limits]
2064	}
2065	set min ""; set max ""
2066	foreach {dataobj comp} $_style2objs($tf) {
2067	set tag $dataobj-$comp
2068	if { ![info exists _serverObjs($tag)] } {
2069	puts stderr "$tag not in serverObjs?"
2070	continue
2071	}
2072	if { ![info exists _limits($tag-min)] } {
2073	puts stderr "$tag no min?"
2074	continue
2075	}
2076	if { $min == "" \|\| $min > $_limits($tag-min) } {
2077	set min $_limits($tag-min)
2078	}
2079	if { $max == "" \|\| $max < $_limits($tag-max) } {
2080	set max $_limits($tag-max)
2081	}
2082	}
2083	if { $min != "" } {
2084	set _limits(vmin) $min
2085	}
2086	if { $max != "" } {
2087	set _limits(vmax) $max
2088	}
2089	return [array get _limits]
2090	}
2091
2092	itcl::body Rappture::FlowvisViewer::BuildViewTab {} {
2093	foreach { key value } {
2094	grid 0
2095	axes 0
2096	outline 1
2097	volume 1
2098	legend 1
2099	particles 1
2100	lic 1
2101	} {
2102	set _settings($this-$key) $value
2103	}
2104
2105	set fg [option get $itk_component(hull) font Font]
2106	#set bfg [option get $itk_component(hull) boldFont Font]
2107
2108	set inner [$itk_component(main) insert end \
2109	-title "View Settings" \
2110	-icon [Rappture::icon wrench]]
2111	$inner configure -borderwidth 4
2112
2113	set ::Rappture::FlowvisViewer::_settings($this-isosurface) 0
2114	checkbutton $inner.isosurface \
2115	-text "Isosurface shading" \
2116	-variable [itcl::scope _settings($this-isosurface)] \
2117	-command [itcl::code $this AdjustSetting isosurface] \
2118	-font "Arial 9"
2119
2120	checkbutton $inner.axes \
2121	-text "Axes" \
2122	-variable [itcl::scope _settings($this-axes)] \
2123	-command [itcl::code $this AdjustSetting axes] \
2124	-font "Arial 9"
2125
2126	checkbutton $inner.grid \
2127	-text "Grid" \
2128	-variable [itcl::scope _settings($this-grid)] \
2129	-command [itcl::code $this AdjustSetting grid] \
2130	-font "Arial 9"
2131
2132	checkbutton $inner.outline \
2133	-text "Outline" \
2134	-variable [itcl::scope _settings($this-outline)] \
2135	-command [itcl::code $this AdjustSetting outline] \
2136	-font "Arial 9"
2137
2138	checkbutton $inner.legend \
2139	-text "Legend" \
2140	-variable [itcl::scope _settings($this-legend)] \
2141	-command [itcl::code $this AdjustSetting legend] \
2142	-font "Arial 9"
2143
2144	checkbutton $inner.volume \
2145	-text "Volume" \
2146	-variable [itcl::scope _settings($this-volume)] \
2147	-command [itcl::code $this AdjustSetting volume] \
2148	-font "Arial 9"
2149
2150	checkbutton $inner.particles \
2151	-text "Particles" \
2152	-variable [itcl::scope _settings($this-particles)] \
2153	-command [itcl::code $this AdjustSetting particles] \
2154	-font "Arial 9"
2155
2156	checkbutton $inner.lic \
2157	-text "Lic" \
2158	-variable [itcl::scope _settings($this-lic)] \
2159	-command [itcl::code $this AdjustSetting lic] \
2160	-font "Arial 9"
2161
2162	frame $inner.frame
2163
2164	blt::table $inner \
2165	0,0 $inner.axes -cspan 2 -anchor w \
2166	1,0 $inner.grid -cspan 2 -anchor w \
2167	2,0 $inner.outline -cspan 2 -anchor w \
2168	3,0 $inner.volume -cspan 2 -anchor w \
2169	4,0 $inner.legend -cspan 2 -anchor w
2170
2171	bind $inner <Map> [itcl::code $this GetFlowInfo $inner]
2172
2173	blt::table configure $inner r* -resize none
2174	blt::table configure $inner r5 -resize expand
2175	}
2176
2177	itcl::body Rappture::FlowvisViewer::BuildVolumeTab {} {
2178	foreach { key value } {
2179	light2side 0
2180	light 40
2181	transp 50
2182	opacity 100
2183	thickness 350
2184	} {
2185	set _settings($this-$key) $value
2186	}
2187
2188	set inner [$itk_component(main) insert end \
2189	-title "Volume Settings" \
2190	-icon [Rappture::icon volume-on]]
2191	$inner configure -borderwidth 4
2192
2193	set fg [option get $itk_component(hull) font Font]
2194	#set bfg [option get $itk_component(hull) boldFont Font]
2195
2196	checkbutton $inner.vol -text "Show volume" -font $fg \
2197	-text "Volume" \
2198	-variable [itcl::scope _settings($this-volume)] \
2199	-command [itcl::code $this AdjustSetting volume] \
2200	-font "Arial 9"
2201
2202	label $inner.shading -text "Shading:" -font $fg
2203
2204	checkbutton $inner.light2side -text "Two-sided lighting" -font $fg \
2205	-variable [itcl::scope _settings($this-light2side)] \
2206	-command [itcl::code $this AdjustSetting light2side]
2207
2208	label $inner.dim -text "Glow" -font $fg
2209	::scale $inner.light -from 0 -to 100 -orient horizontal \
2210	-variable [itcl::scope _settings($this-light)] \
2211	-width 10 \
2212	-showvalue off -command [itcl::code $this AdjustSetting light]
2213	label $inner.bright -text "Surface" -font $fg
2214
2215	label $inner.fog -text "Clear" -font $fg
2216	::scale $inner.transp -from 0 -to 100 -orient horizontal \
2217	-variable [itcl::scope _settings($this-transp)] \
2218	-width 10 \
2219	-showvalue off -command [itcl::code $this AdjustSetting transp]
2220	label $inner.plastic -text "Opaque" -font $fg
2221
2222	label $inner.clear -text "Clear" -font $fg
2223	::scale $inner.opacity -from 0 -to 100 -orient horizontal \
2224	-variable [itcl::scope _settings($this-opacity)] \
2225	-width 10 \
2226	-showvalue off -command [itcl::code $this AdjustSetting opacity]
2227	label $inner.opaque -text "Opaque" -font $fg
2228
2229	label $inner.thin -text "Thin" -font $fg
2230	::scale $inner.thickness -from 0 -to 1000 -orient horizontal \
2231	-variable [itcl::scope _settings($this-thickness)] \
2232	-width 10 \
2233	-showvalue off -command [itcl::code $this AdjustSetting thickness]
2234	label $inner.thick -text "Thick" -font $fg
2235
2236	label $inner.colormap_l -text "Colormap" -font "Arial 9"
2237	itk_component add colormap {
2238	Rappture::Combobox $inner.colormap -width 10 -editable no
2239	}
2240
2241	$inner.colormap choices insert end \
2242	"BCGYR" "BCGYR" \
2243	"BGYOR" "BGYOR" \
2244	"blue" "blue" \
2245	"blue-to-brown" "blue-to-brown" \
2246	"blue-to-orange" "blue-to-orange" \
2247	"blue-to-grey" "blue-to-grey" \
2248	"green-to-magenta" "green-to-magenta" \
2249	"greyscale" "greyscale" \
2250	"nanohub" "nanohub" \
2251	"rainbow" "rainbow" \
2252	"spectral" "spectral" \
2253	"ROYGB" "ROYGB" \
2254	"RYGCB" "RYGCB" \
2255	"brown-to-blue" "brown-to-blue" \
2256	"grey-to-blue" "grey-to-blue" \
2257	"orange-to-blue" "orange-to-blue" \
2258	"none" "none"
2259
2260	$itk_component(colormap) value "BCGYR"
2261	bind $inner.colormap <<Value>> \
2262	[itcl::code $this AdjustSetting colormap]
2263
2264	blt::table $inner \
2265	0,0 $inner.vol -cspan 4 -anchor w -pady 2 \
2266	1,0 $inner.shading -cspan 4 -anchor w -pady {10 2} \
2267	2,0 $inner.light2side -cspan 4 -anchor w -pady 2 \
2268	3,0 $inner.dim -anchor e -pady 2 \
2269	3,1 $inner.light -cspan 2 -pady 2 -fill x \
2270	3,3 $inner.bright -anchor w -pady 2 \
2271	4,0 $inner.fog -anchor e -pady 2 \
2272	4,1 $inner.transp -cspan 2 -pady 2 -fill x \
2273	4,3 $inner.plastic -anchor w -pady 2 \
2274	5,0 $inner.thin -anchor e -pady 2 \
2275	5,1 $inner.thickness -cspan 2 -pady 2 -fill x\
2276	5,3 $inner.thick -anchor w -pady 2
2277
2278	blt::table configure $inner c0 c1 c3 r* -resize none
2279	blt::table configure $inner r6 -resize expand
2280	}
2281
2282	itcl::body Rappture::FlowvisViewer::BuildCutplanesTab {} {
2283	set inner [$itk_component(main) insert end \
2284	-title "Cutplane Settings" \
2285	-icon [Rappture::icon cutbutton]]
2286	$inner configure -borderwidth 4
2287
2288	# X-value slicer...
2289	itk_component add xCutButton {
2290	Rappture::PushButton $inner.xbutton \
2291	-onimage [Rappture::icon x-cutplane] \
2292	-offimage [Rappture::icon x-cutplane] \
2293	-command [itcl::code $this AdjustSetting xcutplane] \
2294	-variable [itcl::scope _settings($this-xcutplane)]
2295	}
2296	Rappture::Tooltip::for $itk_component(xCutButton) \
2297	"Toggle the X cut plane on/off"
2298
2299	itk_component add xCutScale {
2300	::scale $inner.xval -from 100 -to 0 \
2301	-width 10 -orient vertical -showvalue off \
2302	-borderwidth 1 -highlightthickness 0 \
2303	-command [itcl::code $this Slice move x] \
2304	-variable [itcl::scope _settings($this-xcutposition)]
2305	} {
2306	usual
2307	ignore -borderwidth -highlightthickness
2308	}
2309	# Set the default cutplane value before disabling the scale.
2310	$itk_component(xCutScale) set 50
2311	$itk_component(xCutScale) configure -state disabled
2312	Rappture::Tooltip::for $itk_component(xCutScale) \
2313	"@[itcl::code $this SlicerTip x]"
2314
2315	# Y-value slicer...
2316	itk_component add yCutButton {
2317	Rappture::PushButton $inner.ybutton \
2318	-onimage [Rappture::icon y-cutplane] \
2319	-offimage [Rappture::icon y-cutplane] \
2320	-command [itcl::code $this AdjustSetting ycutplane] \
2321	-variable [itcl::scope _settings($this-ycutplane)]
2322	}
2323	Rappture::Tooltip::for $itk_component(yCutButton) \
2324	"Toggle the Y cut plane on/off"
2325
2326	itk_component add yCutScale {
2327	::scale $inner.yval -from 100 -to 0 \
2328	-width 10 -orient vertical -showvalue off \
2329	-borderwidth 1 -highlightthickness 0 \
2330	-command [itcl::code $this Slice move y] \
2331	-variable [itcl::scope _settings($this-ycutposition)]
2332	} {
2333	usual
2334	ignore -borderwidth -highlightthickness
2335	}
2336	Rappture::Tooltip::for $itk_component(yCutScale) \
2337	"@[itcl::code $this SlicerTip y]"
2338	# Set the default cutplane value before disabling the scale.
2339	$itk_component(yCutScale) set 50
2340	$itk_component(yCutScale) configure -state disabled
2341
2342	# Z-value slicer...
2343	itk_component add zCutButton {
2344	Rappture::PushButton $inner.zbutton \
2345	-onimage [Rappture::icon z-cutplane] \
2346	-offimage [Rappture::icon z-cutplane] \
2347	-command [itcl::code $this AdjustSetting zcutplane] \
2348	-variable [itcl::scope _settings($this-zcutplane)]
2349	}
2350	Rappture::Tooltip::for $itk_component(zCutButton) \
2351	"Toggle the Z cut plane on/off"
2352
2353	itk_component add zCutScale {
2354	::scale $inner.zval -from 100 -to 0 \
2355	-width 10 -orient vertical -showvalue off \
2356	-borderwidth 1 -highlightthickness 0 \
2357	-command [itcl::code $this Slice move z] \
2358	-variable [itcl::scope _settings($this-zcutposition)]
2359	} {
2360	usual
2361	ignore -borderwidth -highlightthickness
2362	}
2363	$itk_component(zCutScale) set 50
2364	$itk_component(zCutScale) configure -state disabled
2365	#$itk_component(zCutScale) configure -state disabled
2366	Rappture::Tooltip::for $itk_component(zCutScale) \
2367	"@[itcl::code $this SlicerTip z]"
2368
2369	blt::table $inner \
2370	1,1 $itk_component(xCutButton) \
2371	1,2 $itk_component(yCutButton) \
2372	1,3 $itk_component(zCutButton) \
2373	0,1 $itk_component(xCutScale) \
2374	0,2 $itk_component(yCutScale) \
2375	0,3 $itk_component(zCutScale) \
2376
2377	blt::table configure $inner r0 r1 c* -resize none
2378	blt::table configure $inner r2 c4 -resize expand
2379	blt::table configure $inner c0 -width 2
2380	blt::table configure $inner c1 c2 c3 -padx 2
2381	}
2382
2383	itcl::body Rappture::FlowvisViewer::BuildCameraTab {} {
2384	set inner [$itk_component(main) insert end \
2385	-title "Camera Settings" \
2386	-icon [Rappture::icon camera]]
2387	$inner configure -borderwidth 4
2388
2389	set labels { qw qx qy qz pan-x pan-y zoom }
2390	set row 0
2391	foreach tag $labels {
2392	label $inner.${tag}label -text $tag -font "Arial 9"
2393	entry $inner.${tag} -font "Arial 9" -bg white \
2394	-textvariable [itcl::scope _settings($this-$tag)]
2395	bind $inner.${tag} <KeyPress-Return> \
2396	[itcl::code $this camera set ${tag}]
2397	blt::table $inner \
2398	$row,0 $inner.${tag}label -anchor e -pady 2 \
2399	$row,1 $inner.${tag} -anchor w -pady 2
2400	blt::table configure $inner r$row -resize none
2401	incr row
2402	}
2403	blt::table configure $inner c0 c1 -resize none
2404	blt::table configure $inner c2 -resize expand
2405	blt::table configure $inner r$row -resize expand
2406	}
2407
2408	itcl::body Rappture::FlowvisViewer::GetFlowInfo { w } {
2409	set flowobj ""
2410	foreach key [array names _obj2flow] {
2411	set flowobj $_obj2flow($key)
2412	break
2413	}
2414	if { $flowobj == "" } {
2415	return
2416	}
2417	if { [winfo exists $w.frame] } {
2418	destroy $w.frame
2419	}
2420	set inner [frame $w.frame]
2421	blt::table $w \
2422	5,0 $inner -fill both -cspan 2 -anchor nw
2423	array set hints [$flowobj hints]
2424	checkbutton $inner.showstreams -text "Streams Plane" \
2425	-variable [itcl::scope _settings($this-streams)] \
2426	-command [itcl::code $this streams $key $hints(name)] \
2427	-font "Arial 9"
2428	Rappture::Tooltip::for $inner.showstreams $hints(description)
2429
2430	checkbutton $inner.showarrows -text "Arrows" \
2431	-variable [itcl::scope _settings($this-arrows)] \
2432	-command [itcl::code $this arrows $key $hints(name)] \
2433	-font "Arial 9"
2434
2435	label $inner.particles -text "Particles" -font "Arial 9 bold"
2436	label $inner.boxes -text "Boxes" -font "Arial 9 bold"
2437
2438	blt::table $inner \
2439	1,0 $inner.showstreams -anchor w \
2440	2,0 $inner.showarrows -anchor w
2441	blt::table configure $inner c0 c1 -resize none
2442	blt::table configure $inner c2 -resize expand
2443
2444	set row 3
2445	set particles [$flowobj particles]
2446	if { [llength $particles] > 0 } {
2447	blt::table $inner $row,0 $inner.particles -anchor w
2448	incr row
2449	}
2450	foreach part $particles {
2451	array unset info
2452	array set info $part
2453	set name $info(name)
2454	if { ![info exists _settings($this-particles-$name)] } {
2455	set _settings($this-particles-$name) $info(hide)
2456	}
2457	checkbutton $inner.part$row -text $info(label) \
2458	-variable [itcl::scope _settings($this-particles-$name)] \
2459	-onvalue 0 -offvalue 1 \
2460	-command [itcl::code $this particles $key $name] \
2461	-font "Arial 9"
2462	Rappture::Tooltip::for $inner.part$row $info(description)
2463	blt::table $inner $row,0 $inner.part$row -anchor w
2464	if { !$_settings($this-particles-$name) } {
2465	$inner.part$row select
2466	}
2467	incr row
2468	}
2469	set boxes [$flowobj boxes]
2470	if { [llength $boxes] > 0 } {
2471	blt::table $inner $row,0 $inner.boxes -anchor w
2472	incr row
2473	}
2474	foreach box $boxes {
2475	array unset info
2476	array set info $box
2477	set name $info(name)
2478	if { ![info exists _settings($this-box-$name)] } {
2479	set _settings($this-box-$name) $info(hide)
2480	}
2481	checkbutton $inner.box$row -text $info(label) \
2482	-variable [itcl::scope _settings($this-box-$name)] \
2483	-onvalue 0 -offvalue 1 \
2484	-command [itcl::code $this box $key $name] \
2485	-font "Arial 9"
2486	Rappture::Tooltip::for $inner.box$row $info(description)
2487	blt::table $inner $row,0 $inner.box$row -anchor w
2488	if { !$_settings($this-box-$name) } {
2489	$inner.box$row select
2490	}
2491	incr row
2492	}
2493	blt::table configure $inner r* -resize none
2494	blt::table configure $inner r$row -resize expand
2495	blt::table configure $inner c3 -resize expand
2496	event generate [winfo parent [winfo parent $w]] <Configure>
2497	}
2498
2499	itcl::body Rappture::FlowvisViewer::particles { tag name } {
2500	set bool $_settings($this-particles-$name)
2501	SendCmd "$tag particles configure {$name} -hide $bool"
2502	}
2503
2504	itcl::body Rappture::FlowvisViewer::box { tag name } {
2505	set bool $_settings($this-box-$name)
2506	SendCmd "$tag box configure {$name} -hide $bool"
2507	}
2508
2509	itcl::body Rappture::FlowvisViewer::streams { tag name } {
2510	set bool $_settings($this-streams)
2511	SendCmd "$tag configure -slice $bool"
2512	}
2513
2514	itcl::body Rappture::FlowvisViewer::arrows { tag name } {
2515	set bool $_settings($this-arrows)
2516	SendCmd "$tag configure -arrows $bool"
2517	}
2518
2519	# ----------------------------------------------------------------------
2520	# USAGE: Slice move x\|y\|z <newval>
2521	#
2522	# Called automatically when the user drags the slider to move the
2523	# cut plane that slices 3D data. Gets the current value from the
2524	# slider and moves the cut plane to the appropriate point in the
2525	# data set.
2526	# ----------------------------------------------------------------------
2527	itcl::body Rappture::FlowvisViewer::Slice {option args} {
2528	switch -- $option {
2529	move {
2530	if {[llength $args] != 2} {
2531	error "wrong # args: should be \"Slice move x\|y\|z newval\""
2532	}
2533	set axis [lindex $args 0]
2534	set newval [lindex $args 1]
2535	set newpos [expr {0.01*$newval}]
2536
2537	# show the current value in the readout
2538
2539	set ids [CurrentVolumeIds -cutplanes]
2540	SendCmd "cutplane position $newpos $axis $ids"
2541	}
2542	default {
2543	error "bad option \"$option\": should be axis, move, or volume"
2544	}
2545	}
2546	}
2547
2548	# ----------------------------------------------------------------------
2549	# USAGE: SlicerTip <axis>
2550	#
2551	# Used internally to generate a tooltip for the x/y/z slicer controls.
2552	# Returns a message that includes the current slicer value.
2553	# ----------------------------------------------------------------------
2554	itcl::body Rappture::FlowvisViewer::SlicerTip {axis} {
2555	set val [$itk_component(${axis}CutScale) get]
2556	# set val [expr {0.01*($val-50)
2557	# *($_limits(${axis}max)-$_limits(${axis}min))
2558	# + 0.5*($_limits(${axis}max)+$_limits(${axis}min))}]
2559	return "Move the [string toupper $axis] cut plane.\nCurrently: $axis = $val%"
2560	}
2561
2562	itcl::body Rappture::FlowvisViewer::Resize {} {
2563	$_arcball resize $_width $_height
2564	SendCmd "screen size $_width $_height"
2565	set _resizePending 0
2566	}
2567
2568	itcl::body Rappture::FlowvisViewer::EventuallyResize { w h } {
2569	set _width $w
2570	set _height $h
2571	$_arcball resize $w $h
2572	if { !$_resizePending } {
2573	$_dispatcher event -after 200 !resize
2574	set _resizePending 1
2575	}
2576	}
2577
2578	itcl::body Rappture::FlowvisViewer::EventuallyResizeLegend {} {
2579	if { !$_resizeLegendPending } {
2580	$_dispatcher event -after 100 !legend
2581	set _resizeLegendPending 1
2582	}
2583	}
2584
2585	itcl::body Rappture::FlowvisViewer::EventuallyGoto { nSteps } {
2586	set _flow(goto) $nSteps
2587	if { !$_gotoPending } {
2588	$_dispatcher event -after 1000 !goto
2589	set _gotoPending 1
2590	}
2591	}
2592
2593	# camera --
2594	itcl::body Rappture::FlowvisViewer::camera {option args} {
2595	switch -- $option {
2596	"show" {
2597	puts [array get _view]
2598	}
2599	"set" {
2600	set who [lindex $args 0]
2601	set x $_settings($this-$who)
2602	set code [catch { string is double $x } result]
2603	if { $code != 0 \|\| !$result } {
2604	set _settings($this-$who) $_view($who)
2605	return
2606	}
2607	switch -- $who {
2608	"pan-x" - "pan-y" {
2609	set _view($who) $_settings($this-$who)
2610	PanCamera
2611	}
2612	"qx" - "qy" - "qz" - "qw" {
2613	set q [list $_view(qw) $_view(qx) $_view(qy) $_view(qz)]
2614	$_arcball quaternion $q
2615	SendCmd "camera orient $q"
2616	}
2617	"zoom" {
2618	set _view($who) $_settings($this-$who)
2619	SendCmd "camera zoom $_view(zoom)"
2620	}
2621	}
2622	}
2623	}
2624	}
2625
2626	itcl::body Rappture::FlowvisViewer::FlowCmd { dataobj comp nbytes extents } {
2627	set tag "$dataobj-$comp"
2628	if { ![info exists _obj2flow($tag)] } {
2629	append cmd "flow add $tag\n"
2630	append cmd "$tag data follows $nbytes $extents\n"
2631	return $cmd
2632	}
2633	set flowobj $_obj2flow($tag)
2634	if { $flowobj == "" } {
2635	puts stderr "no flowobj"
2636	return ""
2637	}
2638	set cmd {}
2639	append cmd "if {\[flow exists $tag\]} {flow delete $tag}\n"
2640	array set info [$flowobj hints]
2641	set _settings($this-volume) $info(volume)
2642	set _settings($this-outline) $info(outline)
2643	set _settings($this-arrows) $info(arrows)
2644	set _settings($this-duration) $info(duration)
2645	$itk_component(speed) value $info(speed)
2646	append cmd "flow add $tag"
2647	append cmd " -position $info(position)"
2648	append cmd " -axis $info(axis)"
2649	append cmd " -volume $info(volume)"
2650	append cmd " -outline $info(outline)"
2651	append cmd " -slice $info(streams)"
2652	append cmd " -arrows $info(arrows)\n"
2653	foreach part [$flowobj particles] {
2654	array unset info
2655	array set info $part
2656	set color [Color2RGB $info(color)]
2657	append cmd "$tag particles add $info(name)"
2658	append cmd " -position $info(position)"
2659	append cmd " -hide $info(hide)"
2660	append cmd " -axis $info(axis)"
2661	append cmd " -color {$color}"
2662	append cmd " -size $info(size)\n"
2663	}
2664	foreach box [$flowobj boxes] {
2665	array unset info
2666	set info(corner1) ""
2667	set info(corner2) ""
2668	array set info $box
2669	if { $info(corner1) == "" \|\| $info(corner2) == "" } {
2670	continue
2671	}
2672	set color [Color2RGB $info(color)]
2673	append cmd "$tag box add $info(name)"
2674	append cmd " -color {$color}"
2675	append cmd " -hide $info(hide)"
2676	append cmd " -linewidth $info(linewidth) "
2677	append cmd " -corner1 {$info(corner1)} "
2678	append cmd " -corner2 {$info(corner2)}\n"
2679	}
2680	append cmd "$tag data follows $nbytes $extents\n"
2681	return $cmd
2682	}
2683
2684
2685	#
2686	# flow --
2687	#
2688	# Called when the user clicks on the stop or play buttons
2689	# for flow visualization.
2690	#
2691	# $this flow play
2692	# $this flow stop
2693	# $this flow toggle
2694	# $this flow reset
2695	# $this flow pause
2696	# $this flow next
2697	#
2698	itcl::body Rappture::FlowvisViewer::flow { args } {
2699	set option [lindex $args 0]
2700	switch -- $option {
2701	"goto2" {
2702	puts stderr "actually sending \"flow goto $_flow(goto)\""
2703	SendCmd "flow goto $_flow(goto)"
2704	set _gotoPending 0
2705	}
2706	"goto" {
2707	puts stderr "flow goto to $_settings($this-currenttime)"
2708	# Figure out how many steps to the current time based upon
2709	# the speed and duration.
2710	set current $_settings($this-currenttime)
2711	set speed [$itk_component(speed) value]
2712	set time [str2millisecs $_settings($this-duration)]
2713	$itk_component(dial) configure -max $time
2714	set delay [expr int(round(500.0/$speed))]
2715	set timePerStep [expr {double($time) / $delay}]
2716	set nSteps [expr {int(ceil($current/$timePerStep))}]
2717	EventuallyGoto $nSteps
2718	}
2719	"speed" {
2720	set speed [$itk_component(speed) value]
2721	set _flow(delay) [expr int(round(500.0/$speed))]
2722	}
2723	"duration" {
2724	set max [str2millisecs $_settings($this-duration)]
2725	if { $max < 0 } {
2726	bell
2727	return
2728	}
2729	set _flow(duration) $max
2730	set _settings($this-duration) [millisecs2str $max]
2731	$itk_component(dial) configure -max $max
2732	}
2733	"off" {
2734	set _flow(state) 0
2735	$_dispatcher cancel !play
2736	$itk_component(play) deselect
2737	}
2738	"on" {
2739	flow speed
2740	flow duration
2741	set _flow(state) 1
2742	set _settings($this-currenttime) 0
2743	$itk_component(play) select
2744	}
2745	"stop" {
2746	if { $_flow(state) } {
2747	flow off
2748	flow reset
2749	}
2750	}
2751	"pause" {
2752	if { $_flow(state) } {
2753	flow off
2754	}
2755	}
2756	"play" {
2757	# If the flow is currently off, then restart it.
2758	if { !$_flow(state) } {
2759	flow on
2760	# If we're at the end of the flow, reset the flow.
2761	set _settings($this-currenttime) \
2762	[expr {$_settings($this-currenttime) + $_flow(delay)}]
2763	if { $_settings($this-currenttime) >= $_flow(duration) } {
2764	set _settings($this-step) 1
2765	SendCmd "flow reset"
2766	}
2767	flow next
2768	}
2769	}
2770	"toggle" {
2771	if { $_settings($this-play) } {
2772	flow play
2773	} else {
2774	flow pause
2775	}
2776	}
2777	"reset" {
2778	set _settings($this-currenttime) 0
2779	SendCmd "flow reset"
2780	if { !$_flow(state) } {
2781	SendCmd "flow next"
2782	}
2783	}
2784	"next" {
2785	if { ![winfo viewable $itk_component(3dview)] } {
2786	flow stop
2787	return
2788	}
2789	set _settings($this-currenttime) \
2790	[expr {$_settings($this-currenttime) + $_flow(delay)}]
2791	if { $_settings($this-currenttime) >= $_flow(duration) } {
2792	if { !$_settings($this-loop) } {
2793	flow off
2794	return
2795	}
2796	flow reset
2797	} else {
2798	SendCmd "flow next"
2799	}
2800	$_dispatcher event -after $_flow(delay) !play
2801	}
2802	default {
2803	error "bad option \"$option\": should be play, stop, toggle, or reset."
2804	}
2805	}
2806	}
2807
2808	itcl::body Rappture::FlowvisViewer::WaitIcon { option widget } {
2809	switch -- $option {
2810	"start" {
2811	$_dispatcher dispatch $this !waiticon \
2812	"[itcl::code $this WaitIcon "next" $widget] ; list"
2813	set _icon 0
2814	$widget configure -image [Rappture::icon bigroller${_icon}]
2815	$_dispatcher event -after 100 !waiticon
2816	}
2817	"next" {
2818	incr _icon
2819	if { $_icon >= 8 } {
2820	set _icon 0
2821	}
2822	$widget configure -image [Rappture::icon bigroller${_icon}]
2823	$_dispatcher event -after 100 !waiticon
2824	}
2825	"stop" {
2826	$_dispatcher cancel !waiticon
2827	}
2828	}
2829	}
2830
2831	itcl::body Rappture::FlowvisViewer::GetPngImage { widget width height } {
2832	set token "print[incr _nextToken]"
2833	set var ::Rappture::FlowvisViewer::_hardcopy($this-$token)
2834	set $var ""
2835
2836	# Setup an automatic timeout procedure.
2837	$_dispatcher dispatch $this !pngtimeout "set $var {} ; list"
2838
2839	set popup .flowvisviewerprint
2840	if {![winfo exists $popup]} {
2841	Rappture::Balloon $popup -title "Generating file..."
2842	set inner [$popup component inner]
2843	label $inner.title -text "Generating hardcopy." -font "Arial 10 bold"
2844	label $inner.please -text "This may take a minute." -font "Arial 10"
2845	label $inner.icon -image [Rappture::icon bigroller0]
2846	button $inner.cancel -text "Cancel" -font "Arial 10 bold" \
2847	-command [list set $var ""]
2848	blt::table $inner \
2849	0,0 $inner.title -cspan 2 \
2850	1,0 $inner.please -anchor w \
2851	1,1 $inner.icon -anchor e \
2852	2,0 $inner.cancel -cspan 2
2853	blt::table configure $inner r0 -pady 4
2854	blt::table configure $inner r2 -pady 4
2855	bind $inner.cancel <KeyPress-Return> [list $inner.cancel invoke]
2856	} else {
2857	set inner [$popup component inner]
2858	}
2859
2860	$_dispatcher event -after 60000 !pngtimeout
2861	WaitIcon start $inner.icon
2862	grab set $inner
2863	focus $inner.cancel
2864
2865	SendCmd "print $token $width $height"
2866
2867	$popup activate $widget below
2868	update
2869	# We wait here for either
2870	# 1) the png to be delivered or
2871	# 2) timeout or
2872	# 3) user cancels the operation.
2873	tkwait variable $var
2874
2875	# Clean up.
2876	$_dispatcher cancel !pngtimeout
2877	WaitIcon stop $inner.icon
2878	grab release $inner
2879	$popup deactivate
2880	update
2881
2882	if { $_hardcopy($this-$token) != "" } {
2883	return [list .png $_hardcopy($this-$token)]
2884	}
2885	return ""
2886	}
2887
2888	itcl::body Rappture::FlowvisViewer::GetMovie { widget w h } {
2889	set token "movie[incr _nextToken]"
2890	set var ::Rappture::FlowvisViewer::_hardcopy($this-$token)
2891	set $var ""
2892
2893	# Setup an automatic timeout procedure.
2894	$_dispatcher dispatch $this !movietimeout "set $var {} ; list"
2895	set popup .flowvisviewermovie
2896	if {![winfo exists $popup]} {
2897	Rappture::Balloon $popup -title "Generating movie..."
2898	set inner [$popup component inner]
2899	label $inner.title -text "Generating movie for download" \
2900	-font "Arial 10 bold"
2901	label $inner.please -text "This may take a few minutes." \
2902	-font "Arial 10"
2903	label $inner.icon -image [Rappture::icon bigroller0]
2904	button $inner.cancel -text "Cancel" -font "Arial 10 bold" \
2905	-command [list set $var ""]
2906	blt::table $inner \
2907	0,0 $inner.title -cspan 2 \
2908	1,0 $inner.please -anchor w \
2909	1,1 $inner.icon -anchor e \
2910	2,0 $inner.cancel -cspan 2
2911	blt::table configure $inner r0 -pady 4
2912	blt::table configure $inner r2 -pady 4
2913	bind $inner.cancel <KeyPress-Return> [list $inner.cancel invoke]
2914	} else {
2915	set inner [$popup component inner]
2916	}
2917	# Timeout is set to 10 minutes.
2918	$_dispatcher event -after 600000 !movietimeout
2919	WaitIcon start $inner.icon
2920	grab set $inner
2921	focus $inner.cancel
2922
2923	flow duration
2924	flow speed
2925	set nframes [expr round($_flow(duration) / $_flow(delay))]
2926	set framerate [expr 1000.0 / $_flow(delay)]
2927
2928	# These are specific to MPEG1 video generation
2929	set framerate 25.0
2930	set bitrate 6.0e+6
2931
2932	set start [clock seconds]
2933	SendCmd "flow video $token -width $w -height $h -numframes $nframes "
2934
2935	$popup activate $widget below
2936	update
2937	# We wait here until
2938	# 1. the movie is delivered or
2939	# 2. we've timed out or
2940	# 3. the user has canceled the operation.b
2941	tkwait variable $var
2942
2943	puts stderr "Video generated in [expr [clock seconds] - $start] seconds."
2944
2945	# Clean up.
2946	$_dispatcher cancel !movietimeout
2947	WaitIcon stop $inner.icon
2948	grab release $inner
2949	$popup deactivate
2950	destroy $popup
2951	update
2952
2953	# This will both cancel the movie generation (if it hasn't already
2954	# completed) and reset the flow.
2955	SendCmd "flow reset"
2956	if { $_hardcopy($this-$token) != "" } {
2957	return [list .mpg $_hardcopy($this-$token)]
2958	}
2959	return ""
2960	}
2961
2962	itcl::body Rappture::FlowvisViewer::str2millisecs { value } {
2963	set parts [split $value :]
2964	set secs 0
2965	set mins 0
2966	if { [llength $parts] == 1 } {
2967	scan [lindex $parts 0] "%d" secs
2968	} else {
2969	scan [lindex $parts 1] "%d" secs
2970	scan [lindex $parts 0] "%d" mins
2971	}
2972	set ms [expr {(($mins * 60) + $secs) * 1000.0}]
2973	if { $ms > 600000.0 } {
2974	set ms 600000.0
2975	}
2976	if { $ms == 0.0 } {
2977	set ms 60000.0
2978	}
2979	return $ms
2980	}
2981
2982	itcl::body Rappture::FlowvisViewer::millisecs2str { value } {
2983	set min [expr floor($value / 60000.0)]
2984	set sec [expr ($value - ($min*60000.0)) / 1000.0]
2985	return [format %02d:%02d [expr round($min)] [expr round($sec)]]
2986	}
2987

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

Download in other formats: