Context Navigation

sequenceresult.tcl @ 6467

Last change on this file since 6467 was 6467, checked in by ldelgass, 8 years ago
merge r6412 from trunk (sequence of meshes)
File size: 20.5 KB

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

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

Context Navigation

source: branches/1.7/gui/scripts/sequenceresult.tcl @ 6467

Download in other formats: