Context Navigation

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

Last change on this file since 2035 was 1930, checked in by gah, 14 years ago

File size: 20.1 KB

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

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

Download in other formats: