Context Navigation

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

Last change on this file since 1491 was 1491, checked in by gah, 15 years ago
update for flowvisviewer: speed controls, arrows, volume checkbutton
File size: 91.5 KB

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

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

Download in other formats: