Context Navigation

source: trunk/gui/scripts/sequenceresult.tcl @ 3108

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

File size: 22.5 KB

Line
1
2	# ----------------------------------------------------------------------
3	# COMPONENT: sequenceresult - series of results forming an animation
4	#
5	# This widget displays a series of results of the same type that are
6	# grouped together and displayed as an animation. The user can play
7	# through the results, or single step through individual values.
8	# ======================================================================
9	# AUTHOR: Michael McLennan, Purdue University
10	# Copyright (c) 2004-2005 Purdue Research Foundation
11	#
12	# See the file "license.terms" for information on usage and
13	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14	# ======================================================================
15	package require Itk
16	package require BLT
17
18	option add *SequenceResult.width 3i widgetDefault
19	option add *SequenceResult.height 3i widgetDefault
20	option add *SequenceResult.controlBackground gray widgetDefault
21	option add *SequenceResult.dialProgressColor #ccccff widgetDefault
22	option add *SequenceResult.font \
23	--helvetica-medium-r-normal--12-* widgetDefault
24	option add *SequenceResult.boldFont \
25	--helvetica-bold-r-normal--12-* widgetDefault
26
27	itcl::class Rappture::SequenceResult {
28	inherit itk::Widget
29
30	constructor {args} {
31	# defined below
32	}
33	destructor {
34	# defined below
35	}
36	public method add {dataobj {settings ""}}
37	public method get {}
38	public method delete {args}
39	public method scale {args}
40	public method parameters {title args} {
41	# do nothing
42	}
43	public method download {option args}
44
45	public method play {}
46	public method pause {}
47	public method goto {{newval ""}}
48
49	protected method _rebuild {args}
50	protected method _playFrame {}
51	protected method _fixValue {}
52
53	private variable _dispatcher "" ;# dispatcher for !events
54	private variable _dlist "" ;# list of data objects
55	private variable _topmost "" ;# topmost data object in _dlist
56	private variable _indices "" ;# list of active indices
57	private variable _pos 0 ;# current position in the animation
58	private variable _afterId "" ;# current "after" event for play op
59
60	private common _play ;# options for "play" operation
61	set _play(speed) 60
62	set _play(loop) 0
63	}
64
65	itk::usual SequenceResult {
66	keep -background -foreground -cursor -font
67	}
68
69	# ----------------------------------------------------------------------
70	# CONSTRUCTOR
71	# ----------------------------------------------------------------------
72	itcl::body Rappture::SequenceResult::constructor {args} {
73	Rappture::dispatcher _dispatcher
74	$_dispatcher register !rebuild
75	$_dispatcher dispatch $this !rebuild [itcl::code $this _rebuild]
76
77	option add hull.width hull.height
78	pack propagate $itk_component(hull) no
79
80	itk_component add player {
81	frame $itk_interior.player
82	}
83	pack $itk_component(player) -side bottom -fill x
84	grid columnconfigure $itk_component(player) 1 -weight 1
85
86	itk_component add play {
87	button $itk_component(player).play \
88	-bitmap [Rappture::icon play] \
89	-command [itcl::code $this play]
90	}
91	grid $itk_component(play) -row 0 -rowspan 2 -column 0 \
92	-ipadx 2 -padx {0 4} -pady 4 -sticky nsew
93
94	itk_component add dial {
95	Rappture::Radiodial $itk_component(player).dial \
96	-length 10 -valuewidth 0 -valuepadding 0 -padding 6 \
97	-linecolor "" -activelinecolor "" \
98	-knobimage [Rappture::icon knob2] -knobposition center@middle
99	} {
100	usual
101	keep -dialprogresscolor
102	}
103	grid $itk_component(dial) -row 1 -column 1 -sticky ew
104	bind $itk_component(dial) <<Value>> [itcl::code $this _fixValue]
105
106	itk_component add info {
107	frame $itk_component(player).info
108	}
109	grid $itk_component(info) -row 0 -column 1 -columnspan 2 -sticky ew
110
111	itk_component add indexLabel {
112	label $itk_component(info).ilabel
113	} {
114	usual
115	rename -font -boldfont boldFont Font
116	}
117	pack $itk_component(indexLabel) -side left
118
119	itk_component add indexValue {
120	label $itk_component(info).ivalue -padx 0
121	}
122	pack $itk_component(indexValue) -side left
123
124	# add an element.about.label stanza
125	itk_component add eleLabel {
126	label $itk_component(info).elabel -padx 10
127	}
128	pack $itk_component(eleLabel) -side left
129
130	itk_component add options {
131	button $itk_component(player).options -text "Options..." \
132	-padx 1 -pady 0 -relief flat -overrelief raised
133	}
134	grid $itk_component(options) -row 1 -column 2 -sticky sw
135
136	#
137	# Popup option panel
138	#
139	set fn [option get $itk_component(hull) font Font]
140	set bfn [option get $itk_component(hull) boldFont Font]
141
142	Rappture::Balloon $itk_component(hull).popup \
143	-title "Player Settings" -padx 4 -pady 4
144	set inner [$itk_component(hull).popup component inner]
145
146	label $inner.loopl -text "Loop:" -font $bfn
147	grid $inner.loopl -row 0 -column 0 -sticky e
148	radiobutton $inner.loopOn -text "Play once and stop" -font $fn \
149	-variable ::Rappture::SequenceResult::_play(loop) -value 0
150	grid $inner.loopOn -row 0 -column 1 -sticky w
151	radiobutton $inner.loopOff -text "Play continuously" -font $fn \
152	-variable ::Rappture::SequenceResult::_play(loop) -value 1
153	grid $inner.loopOff -row 1 -column 1 -sticky w
154	grid rowconfigure $inner 2 -minsize 8
155
156	label $inner.speedl -text "Speed:" -font $bfn
157	grid $inner.speedl -row 3 -column 0 -sticky e
158	frame $inner.speed
159	grid $inner.speed -row 3 -column 1 -sticky ew
160	label $inner.speed.slowl -text "Slower" -font $fn
161	pack $inner.speed.slowl -side left
162	::scale $inner.speed.value -from 100 -to 1 \
163	-showvalue 0 -orient horizontal \
164	-variable ::Rappture::SequenceResult::_play(speed)
165	pack $inner.speed.value -side left
166	label $inner.speed.fastl -text "Faster" -font $fn
167	pack $inner.speed.fastl -side left
168
169	$itk_component(options) configure -command \
170	[list $itk_component(hull).popup activate $itk_component(options) above]
171
172	#
173	# Main viewer
174	#
175	itk_component add area {
176	frame $itk_interior.area
177	}
178	pack $itk_component(area) -expand yes -fill both
179
180	eval itk_initialize $args
181	}
182
183	# ----------------------------------------------------------------------
184	# DESTRUCTOR
185	# ----------------------------------------------------------------------
186	itcl::body Rappture::SequenceResult::destructor {} {
187	pause ;# stop any animation that might be playing
188	}
189
190	# ----------------------------------------------------------------------
191	# USAGE: add <sequence> ?<settings>?
192	#
193	# Clients use this to add a data sequence to the viewer. The optional
194	# <settings> are used to configure the display of the data. Allowed
195	# settings are -color, -brightness, -width, -linestyle and -raise.
196	# The only setting used here is -raise, which indicates the current
197	# object.
198	# ----------------------------------------------------------------------
199	itcl::body Rappture::SequenceResult::add {dataobj {settings ""}} {
200	array set params {
201	-color auto
202	-brightness 0
203	-width 1
204	-raise 0
205	-linestyle solid
206	-description ""
207	-param ""
208	}
209	foreach {opt val} $settings {
210	if {![info exists params($opt)]} {
211	error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
212	}
213	set params($opt) $val
214	}
215
216	if {$params(-raise) && "" == $_topmost} {
217	set _topmost $dataobj
218	}
219	lappend _dlist $dataobj
220	$_dispatcher event -idle !rebuild
221	}
222
223	# ----------------------------------------------------------------------
224	# USAGE: get
225	#
226	# Clients use this to query the list of data objects being displayed,
227	# in order from bottom to top of this result.
228	# ----------------------------------------------------------------------
229	itcl::body Rappture::SequenceResult::get {} {
230	# put the dataobj list in order according to -raise options
231	set dlist $_dlist
232
233	set i [lsearch $_dlist $_topmost]
234	if {$i >= 0} {
235	set dlist [lreplace $dlist $i $i]
236	set dlist [linsert $dlist 0 $_topmost]
237	}
238	return $dlist
239	}
240
241	# ----------------------------------------------------------------------
242	# USAGE: delete ?<dataobj1> <dataobj2> ...?
243	#
244	# Clients use this to delete a data object from the viewer. If no
245	# data objects are specified, then all data objects are deleted.
246	# ----------------------------------------------------------------------
247	itcl::body Rappture::SequenceResult::delete {args} {
248	if {[llength $args] == 0} {
249	set args $_dlist
250	}
251	pause
252
253	# delete all specified curves
254	set changed 0
255	foreach dataobj $args {
256	set pos [lsearch -exact $_dlist $dataobj]
257	if {$pos >= 0} {
258	set _dlist [lreplace $_dlist $pos $pos]
259	set changed 1
260
261	if {$dataobj == $_topmost} {
262	set _topmost ""
263	}
264	}
265	}
266
267	# if anything changed, then rebuild the plot
268	if {$changed} {
269	$_dispatcher event -idle !rebuild
270	}
271	}
272
273	# ----------------------------------------------------------------------
274	# USAGE: scale ?<dataobj1> <dataobj2> ...?
275	#
276	# Sets the default limits for the overall plot according to the
277	# limits of the data for all of the given <dataobj> objects. This
278	# accounts for all data objects--even those not showing on the screen.
279	# Because of this, the limits are appropriate for all data objects as
280	# the user scans through data in the ResultSet viewer.
281	# ----------------------------------------------------------------------
282	itcl::body Rappture::SequenceResult::scale {args} {
283	# do nothing
284	}
285
286	# ----------------------------------------------------------------------
287	# USAGE: download coming
288	# USAGE: download controls <downloadCommand>
289	# USAGE: download now
290	#
291	# Clients use this method to create a downloadable representation
292	# of the plot. Returns a list of the form {ext string}, where
293	# "ext" is the file extension (indicating the type of data) and
294	# "string" is the data itself.
295	# ----------------------------------------------------------------------
296	itcl::body Rappture::SequenceResult::download {option args} {
297	if { ![winfo exists $itk_component(area).viewer] } {
298	return ""; # No data, no viewer, no download.
299	}
300	switch $option {
301	coming {
302	return [$itk_component(area).viewer download coming]
303	}
304	controls {
305	return [eval $itk_component(area).viewer download controls $args]
306	}
307	now {
308	if {0} {
309	# produce a movie of results
310	set rval ""
311	if {"" != $_topmost} {
312	set max [$_topmost size]
313	set all ""
314	for {set i 0} {$i < $max} {incr i} {
315	set dataobj [lindex [$_topmost value $i] 0]
316	if {[catch {$dataobj tkimage} imh] == 0} {
317	lappend all $imh
318	}
319	}
320	if {[llength $all] > 0} {
321	set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
322	set rval [eval Rappture::icon::gif_animate $delay $all]
323	}
324	}
325	if {[string length $rval] > 0} {
326	return [list .gif $rval]
327	}
328	return ""
329	}
330	# otherwise, return download of single frame
331	return [eval $itk_component(area).viewer download now $args]
332	}
333	default {
334	error "bad option \"$option\": should be coming, controls, now"
335	}
336	}
337	}
338
339	# ----------------------------------------------------------------------
340	# USAGE: play
341	#
342	# Invoked when the user hits the "play" button to play the current
343	# sequence of frames as a movie.
344	# ----------------------------------------------------------------------
345	itcl::body Rappture::SequenceResult::play {} {
346	if { [llength $_indices] == 0 } {
347	return; # No frames (i.e. no data).
348	}
349	# Stop any existing animation.
350	pause
351
352	# At the end? then restart fresh
353	if {$_pos >= [llength $_indices]-1} {
354	goto 0
355	}
356
357	# Toggle the button to "pause" mode
358	$itk_component(play) configure \
359	-bitmap [Rappture::icon pause] \
360	-command [itcl::code $this pause]
361
362	global readyForNextFrame
363	set readyForNextFrame 1; # By default, always ready
364	# Schedule the first frame
365	set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
366	set _afterId [after $delay [itcl::code $this _playFrame]]
367	}
368
369	# ----------------------------------------------------------------------
370	# USAGE: pause
371	#
372	# Invoked when the user hits the "pause" button to stop playing the
373	# current sequence of frames as a movie.
374	# ----------------------------------------------------------------------
375	itcl::body Rappture::SequenceResult::pause {} {
376	if {"" != $_afterId} {
377	catch {after cancel $_afterId}
378	set _afterId ""
379	}
380	global readyForNextFrame
381	set readyForNextFrame 1; # By default, always ready
382
383	# Check if the play button still exists. We may be in the process
384	# of destroying the widget.
385	if { [info exists itk_component(play)] } {
386	# toggle the button to "play" mode
387	$itk_component(play) configure \
388	-bitmap [Rappture::icon play] \
389	-command [itcl::code $this play]
390	}
391	}
392
393	# ----------------------------------------------------------------------
394	# USAGE: goto ?<index>?
395	#
396	# Used internally to move the current position of the animation to
397	# the frame at a particular <index>. If the <index> is not specified,
398	# then it returns the current position.
399	# ----------------------------------------------------------------------
400	itcl::body Rappture::SequenceResult::goto {{newval ""}} {
401	if {"" == $newval} {
402	return $_pos
403	}
404	set _pos $newval
405	set val [$itk_component(dial) get -format label @$_pos]
406	$itk_component(dial) current $val
407	}
408
409	# ----------------------------------------------------------------------
410	# USAGE: _rebuild
411	#
412	# Invoked automatically whenever the data displayed in this viewer
413	# changes. Loads the data from the topmost (current) value into
414	# the viewer.
415	# ----------------------------------------------------------------------
416	itcl::body Rappture::SequenceResult::_rebuild {args} {
417	if {"" == $_topmost && [llength $_dlist] > 0} {
418	set _topmost [lindex $_dlist 0]
419	}
420
421	#
422	# If we have any data, then show the viewer.
423	# Otherwise, hide it.
424	#
425	set viewer $itk_component(area).viewer
426	if {[winfo exists $viewer]} {
427	if {"" == $_topmost} {
428	pack forget $viewer
429	pack forget $itk_component(player)
430	return
431	} else {
432	pack $viewer -expand yes -fill both
433	pack $itk_component(player) -side bottom -fill x
434	}
435	} else {
436	if {"" == $_topmost} {
437	return
438	}
439
440	set type ""
441	if {[$_topmost size] > 0} {
442	set dataobj [lindex [$_topmost value 0] 0]
443	set type [$dataobj info class]
444	}
445	switch -- $type {
446	::Rappture::Drawing {
447	Rappture::VtkViewer $viewer
448	pack $viewer -expand yes -fill both
449	}
450	::Rappture::Curve {
451	Rappture::XyResult $viewer
452	pack $viewer -expand yes -fill both
453	}
454	::Rappture::Histogram {
455	Rappture::HistogramResult $viewer
456	pack $viewer -expand yes -fill both
457	}
458	::Rappture::DataTable {
459	Rappture::DataTable $viewer
460	pack $viewer -expand yes -fill both
461	}
462	::Rappture::Image {
463	Rappture::ImageResult $viewer
464	pack $viewer -expand yes -fill both
465	}
466	::Rappture::Field {
467	set dimensions ""
468	set dim ""
469	foreach dim [$dataobj components -dimensions] {
470	# check to see if the dimensions are the same
471	# for all elements of the field. i dont think
472	# we can display fields of differing dimensions
473	# within the same field object.
474	if {"" != $dimensions} {
475	if {$dimensions != $dim} {
476	error "don't know how to view sequences of $type\
477	with dimensions as follows:\
478	[$dataobj components -dimensions]"
479	}
480	} else {
481	set dimensions $dim
482	}
483	}
484	switch -- $dimensions {
485	2D {
486	global env
487	if { [$dataobj isunirect2d] } {
488	if { [$dataobj hints type] == "contour" } {
489	set mode "vtkcontour"
490	} elseif { [info exists env(VTKHEIGHTMAP)] } {
491	set mode "vtkheightmap"
492	} else {
493	set mode "heightmap"
494	}
495	} elseif { [info exists env(VTKCONTOUR)] } {
496	set mode "vtkcontour"
497	} else {
498	set mode "vtk"
499	}
500	set extents [$dataobj extents]
501	if { $extents > 1 } {
502	set mode "flowvis"
503	}
504	Rappture::Field2DResult $viewer -mode $mode
505	}
506	3D {
507	set fmt [$dataobj type]
508	switch -- $fmt {
509	"points-on-mesh" {
510	set mesh [$dataobj mesh]
511	set fmt [expr {("" != $mesh) ? "vtk" : "nanovis"}]
512	set extents [$dataobj extents]
513	if { $extents > 1 } {
514	set fmt "flowvis"
515	}
516	}
517	"opendx" - "dx" {
518	set fmt "nanovis"
519	set extents [$dataobj extents]
520	if { $extents > 1 } {
521	set fmt "flowvis"
522	}
523	}
524	"vtkvolume" {
525	set fmt "vtkvolume"
526	}
527	"vtkstreamlines" {
528	set fmt "vtkstreamlines"
529	}
530	"" {
531	set fmt "auto"
532	}
533	}
534	Rappture::Field3DResult $viewer -mode $fmt
535	}
536	default {
537	error "don't know how to view sequences of $type\
538	with $dimensions dimensions"
539	}
540	}
541	pack $viewer -expand yes -fill both
542	}
543	::Rappture::LibraryObj {
544	switch -- [$dataobj element -as type] {
545	structure {
546	Rappture::DeviceResult $viewer
547	pack $viewer -expand yes -fill both
548	}
549	default {
550	error "don't know how to view sequences of [$dataobj element -as type]"
551	}
552	}
553	}
554	default {
555	puts stderr "don't know how to view sequences of type \"$type\""
556	puts stderr "Is the sequence empty?"
557	return
558	}
559	}
560	}
561
562	#
563	# Load the current sequence info the viewer.
564	#
565	$itk_component(indexLabel) configure -text [$_topmost hints indexlabel]
566
567	$viewer delete
568	$itk_component(dial) clear
569
570	set max [$_topmost size]
571	set all ""
572	for {set i 0} {$i < $max} {incr i} {
573	eval lappend all [$_topmost value $i]
574	}
575	eval $viewer scale $all
576
577	set _indices ""
578	for {set i 0} {$i < $max} {incr i} {
579	set index [$_topmost index $i]
580	eval $itk_component(dial) add $index
581	lappend _indices [lindex $index 0]
582	}
583	_fixValue
584	}
585
586	# ----------------------------------------------------------------------
587	# USAGE: _playFrame
588	#
589	# Used internally to advance each frame in the animation. Advances
590	# the frame and displays it. When we reach the end of the animation,
591	# we either loop back or stop.
592	# ----------------------------------------------------------------------
593	itcl::body Rappture::SequenceResult::_playFrame {} {
594	global readyForNextFrame
595	if { $readyForNextFrame } {
596	set _pos [expr {$_pos+1}]
597	set last [expr {[llength $_indices]-1}]
598
599	if {$_pos > $last} {
600	if {$_play(loop)} {
601	set _pos 0
602	} else {
603	set _pos $last
604	pause
605	return
606	}
607	}
608	goto $_pos
609	set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
610	} else {
611	set delay 50; # Poll for completion
612	}
613	set _afterId [after $delay [itcl::code $this _playFrame]]
614	}
615
616	# ----------------------------------------------------------------------
617	# USAGE: _fixValue
618	#
619	# Invoked automatically whenever the value on the dial changes.
620	# Updates the viewer to display the value for the selected result.
621	# ----------------------------------------------------------------------
622	itcl::body Rappture::SequenceResult::_fixValue {} {
623	set viewer $itk_component(area).viewer
624	if {![winfo exists $viewer]} {
625	return
626	}
627	$viewer delete
628	if { $_topmost == "" } {
629	return
630	}
631	set val [$itk_component(dial) get -format label current]
632	set _pos [lsearch -glob $_indices $val*]
633	# populate the label for this element
634	if { "" != [$_topmost hints indexlabel] } {
635	$itk_component(indexValue) configure -text "= $val"
636	}
637	$itk_component(eleLabel) configure -text "[$_topmost label $_pos]"
638	foreach dataobj [$_topmost value $_pos] {
639	set settings "-color autoreset -width 2"
640	if {[catch {$dataobj hints style} style] == 0} {
641	eval lappend settings $style
642	}
643	if { [catch {$dataobj hints type} type] == 0} {
644	if {"" != $type} {
645	lappend settings -type $type
646	}
647	}
648	$viewer add $dataobj $settings
649	}
650	}

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

Download in other formats: