Context Navigation

sequenceresult.tcl @ 4169

Last change on this file since 4169 was 4169, checked in by ldelgass, 11 years ago

Collapse Field2DResult and Field3DResult into FieldResult? and rely on Field
object to set default viewer appropriately. Also, don't try to fall back to
old Tcl VTK contour viewer. We should probably show the user an appropriate
error message if we don't have a valid viewer (which really shouldn't ever
happen). If no server can be reached, should we leave it to the specific
viewer widget to handle the error or should we delete the viewer and bubble
the error up to the FieldResult? widget?

File size: 20.5 KB

Line
1	# -- mode: tcl; indent-tabs-mode: nil --
2
3	# ----------------------------------------------------------------------
4	# COMPONENT: sequenceresult - series of results forming an animation
5	#
6	# This widget displays a series of results of the same type that are
7	# grouped together and displayed as an animation. The user can play
8	# through the results, or single step through individual values.
9	# ======================================================================
10	# AUTHOR: Michael McLennan, Purdue University
11	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
12	#
13	# See the file "license.terms" for information on usage and
14	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15	# ======================================================================
16	package require Itk
17	package require BLT
18
19	option add *SequenceResult.width 3i widgetDefault
20	option add *SequenceResult.height 3i widgetDefault
21	option add *SequenceResult.controlBackground gray widgetDefault
22	option add *SequenceResult.dialProgressColor #ccccff widgetDefault
23	option add *SequenceResult.font \
24	--helvetica-medium-r-normal--12-* widgetDefault
25	option add *SequenceResult.boldFont \
26	--helvetica-bold-r-normal--12-* widgetDefault
27
28	itcl::class Rappture::SequenceResult {
29	inherit itk::Widget
30
31	constructor {args} {
32	# defined below
33	}
34	destructor {
35	# defined below
36	}
37	public method add {dataobj {settings ""}}
38	public method get {}
39	public method delete {args}
40	public method scale {args}
41	public method parameters {title args} {
42	# do nothing
43	}
44	public method download {option args}
45
46	public method play {{why -program}}
47	public method pause {{why -program}}
48	public method goto {{newval ""}}
49
50	protected method _rebuild {args}
51	protected method _playFrame {}
52	protected method _fixValue {}
53
54	private variable _dispatcher "" ;# dispatcher for !events
55	private variable _dlist "" ;# list of data objects
56	private variable _topmost "" ;# topmost data object in _dlist
57	private variable _indices "" ;# list of active indices
58	private variable _pos 0 ;# current position in the animation
59	private variable _afterId "" ;# current "after" event for play op
60
61	private common _play ;# options for "play" operation
62	set _play(speed) 60
63	set _play(loop) 0
64	}
65
66	itk::usual SequenceResult {
67	keep -background -foreground -cursor -font
68	}
69
70	# ----------------------------------------------------------------------
71	# CONSTRUCTOR
72	# ----------------------------------------------------------------------
73	itcl::body Rappture::SequenceResult::constructor {args} {
74	Rappture::dispatcher _dispatcher
75	$_dispatcher register !rebuild
76	$_dispatcher dispatch $this !rebuild [itcl::code $this _rebuild]
77
78	option add hull.width hull.height
79	pack propagate $itk_component(hull) no
80
81	itk_component add player {
82	frame $itk_interior.player
83	}
84	pack $itk_component(player) -side bottom -fill x
85	grid columnconfigure $itk_component(player) 1 -weight 1
86
87	itk_component add play {
88	button $itk_component(player).play \
89	-bitmap [Rappture::icon play] \
90	-command [itcl::code $this play -user]
91	}
92	grid $itk_component(play) -row 0 -rowspan 2 -column 0 \
93	-ipadx 2 -padx {0 4} -pady 4 -sticky nsew
94
95	itk_component add dial {
96	Rappture::SequenceDial $itk_component(player).dial \
97	-length 10 -valuewidth 0 -valuepadding 0 -padding 6 \
98	-linecolor "" -activelinecolor "" \
99	-knobimage [Rappture::icon knob2] -knobposition center@middle
100	} {
101	usual
102	keep -dialprogresscolor
103	}
104	grid $itk_component(dial) -row 1 -column 1 -sticky ew
105	bind $itk_component(dial) <<Value>> [itcl::code $this _fixValue]
106
107	# use this command for logging "goto" interactions
108	$itk_component(dial) configure -interactcommand \
109	[format {Rappture::Logger::log sequence goto [%s get -format label current]} $itk_component(dial)]
110
111	itk_component add info {
112	frame $itk_component(player).info
113	}
114	grid $itk_component(info) -row 0 -column 1 -columnspan 2 -sticky ew
115
116	itk_component add indexLabel {
117	label $itk_component(info).ilabel
118	} {
119	usual
120	rename -font -boldfont boldFont Font
121	}
122	pack $itk_component(indexLabel) -side left
123
124	itk_component add indexValue {
125	label $itk_component(info).ivalue -padx 0
126	}
127	pack $itk_component(indexValue) -side left
128
129	# add an element.about.label stanza
130	itk_component add eleLabel {
131	label $itk_component(info).elabel -padx 10
132	}
133	pack $itk_component(eleLabel) -side left
134
135	itk_component add options {
136	button $itk_component(player).options -text "Options..." \
137	-padx 1 -pady 0 -relief flat -overrelief raised
138	}
139	grid $itk_component(options) -row 1 -column 2 -sticky sw
140
141	#
142	# Popup option panel
143	#
144	set fn [option get $itk_component(hull) font Font]
145	set bfn [option get $itk_component(hull) boldFont Font]
146
147	Rappture::Balloon $itk_component(hull).popup \
148	-title "Player Settings" -padx 4 -pady 4
149	set inner [$itk_component(hull).popup component inner]
150
151	label $inner.loopl -text "Loop:" -font $bfn
152	grid $inner.loopl -row 0 -column 0 -sticky e
153	radiobutton $inner.loopOn -text "Play once and stop" -font $fn \
154	-variable ::Rappture::SequenceResult::_play(loop) -value 0
155	grid $inner.loopOn -row 0 -column 1 -sticky w
156	radiobutton $inner.loopOff -text "Play continuously" -font $fn \
157	-variable ::Rappture::SequenceResult::_play(loop) -value 1
158	grid $inner.loopOff -row 1 -column 1 -sticky w
159	grid rowconfigure $inner 2 -minsize 8
160
161	label $inner.speedl -text "Speed:" -font $bfn
162	grid $inner.speedl -row 3 -column 0 -sticky e
163	frame $inner.speed
164	grid $inner.speed -row 3 -column 1 -sticky ew
165	label $inner.speed.slowl -text "Slower" -font $fn
166	pack $inner.speed.slowl -side left
167	::scale $inner.speed.value -from 100 -to 1 \
168	-showvalue 0 -orient horizontal \
169	-variable ::Rappture::SequenceResult::_play(speed)
170	pack $inner.speed.value -side left
171	label $inner.speed.fastl -text "Faster" -font $fn
172	pack $inner.speed.fastl -side left
173
174	$itk_component(options) configure -command \
175	[list $itk_component(hull).popup activate $itk_component(options) above]
176
177	#
178	# Main viewer
179	#
180	itk_component add area {
181	frame $itk_interior.area
182	}
183	pack $itk_component(area) -expand yes -fill both
184
185	eval itk_initialize $args
186	}
187
188	# ----------------------------------------------------------------------
189	# DESTRUCTOR
190	# ----------------------------------------------------------------------
191	itcl::body Rappture::SequenceResult::destructor {} {
192	pause ;# stop any animation that might be playing
193	}
194
195	# ----------------------------------------------------------------------
196	# USAGE: add <sequence> ?<settings>?
197	#
198	# Clients use this to add a data sequence to the viewer. The optional
199	# <settings> are used to configure the display of the data. Allowed
200	# settings are -color, -brightness, -width, -linestyle and -raise.
201	# The only setting used here is -raise, which indicates the current
202	# object.
203	# ----------------------------------------------------------------------
204	itcl::body Rappture::SequenceResult::add {dataobj {settings ""}} {
205	array set params {
206	-color auto
207	-brightness 0
208	-width 1
209	-raise 0
210	-linestyle solid
211	-description ""
212	-param ""
213	}
214	array set params $settings
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 ?-user\|-program?
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 {{why -program}} {
346	if { [llength $_indices] == 0 } {
347	return; # No frames (i.e. no data).
348	}
349
350	if {$why eq "-user"} {
351	Rappture::Logger::log sequence play -loop $_play(loop) -speed $_play(speed)
352	}
353
354	# Stop any existing animation.
355	pause
356
357	# At the end? then restart fresh
358	if {$_pos >= [llength $_indices]-1} {
359	goto 0
360	}
361
362	# Toggle the button to "pause" mode
363	$itk_component(play) configure \
364	-bitmap [Rappture::icon pause] \
365	-command [itcl::code $this pause -user]
366
367	global readyForNextFrame
368	set readyForNextFrame 1; # By default, always ready
369	# Schedule the first frame
370	set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
371	set _afterId [after $delay [itcl::code $this _playFrame]]
372	}
373
374	# ----------------------------------------------------------------------
375	# USAGE: pause ?-user\|-program?
376	#
377	# Invoked when the user hits the "pause" button to stop playing the
378	# current sequence of frames as a movie.
379	# ----------------------------------------------------------------------
380	itcl::body Rappture::SequenceResult::pause {{why -program}} {
381	if {$why eq "-user"} {
382	Rappture::Logger::log sequence pause
383	}
384
385	if {"" != $_afterId} {
386	catch {after cancel $_afterId}
387	set _afterId ""
388	}
389	global readyForNextFrame
390	set readyForNextFrame 1; # By default, always ready
391
392	# Check if the play button still exists. We may be in the process
393	# of destroying the widget.
394	if { [info exists itk_component(play)] } {
395	# toggle the button to "play" mode
396	$itk_component(play) configure \
397	-bitmap [Rappture::icon play] \
398	-command [itcl::code $this play -user]
399	}
400	}
401
402	# ----------------------------------------------------------------------
403	# USAGE: goto ?<index>?
404	#
405	# Used internally to move the current position of the animation to
406	# the frame at a particular <index>. If the <index> is not specified,
407	# then it returns the current position.
408	# ----------------------------------------------------------------------
409	itcl::body Rappture::SequenceResult::goto {{newval ""}} {
410	if {"" == $newval} {
411	return $_pos
412	}
413	set _pos $newval
414	set val [$itk_component(dial) get -format label @$_pos]
415	$itk_component(dial) current $val
416	}
417
418	# ----------------------------------------------------------------------
419	# USAGE: _rebuild
420	#
421	# Invoked automatically whenever the data displayed in this viewer
422	# changes. Loads the data from the topmost (current) value into
423	# the viewer.
424	# ----------------------------------------------------------------------
425	itcl::body Rappture::SequenceResult::_rebuild {args} {
426	if {"" == $_topmost && [llength $_dlist] > 0} {
427	set _topmost [lindex $_dlist 0]
428	}
429
430	#
431	# If we have any data, then show the viewer.
432	# Otherwise, hide it.
433	#
434	set w $itk_component(area).viewer
435	if {[winfo exists $w]} {
436	if {"" == $_topmost} {
437	pack forget $w
438	pack forget $itk_component(player)
439	return
440	} else {
441	pack $w -expand yes -fill both
442	pack $itk_component(player) -side bottom -fill x
443	}
444	} else {
445	if {"" == $_topmost} {
446	return
447	}
448
449	set type ""
450	if {[$_topmost size] > 0} {
451	set dataobj [lindex [$_topmost value 0] 0]
452	set type [$dataobj info class]
453	}
454	switch -- $type {
455	::Rappture::Drawing {
456	set servers [Rappture::VisViewer::GetServerList "vtkvis"]
457	Rappture::VtkViewer $w $servers
458	pack $w -expand yes -fill both
459	}
460	::Rappture::Curve {
461	Rappture::XyResult $w
462	pack $w -expand yes -fill both
463	}
464	::Rappture::Histogram {
465	Rappture::HistogramResult $w
466	pack $w -expand yes -fill both
467	}
468	::Rappture::DataTable {
469	Rappture::DataTable $w
470	pack $w -expand yes -fill both
471	}
472	::Rappture::Image {
473	Rappture::ImageResult $w
474	pack $w -expand yes -fill both
475	}
476	::Rappture::Field {
477	set dimensions ""
478	set dim ""
479	foreach dim [$dataobj components -dimensions] {
480	# check to see if the dimensions are the same
481	# for all elements of the field. i dont think
482	# we can display fields of differing dimensions
483	# within the same field object.
484	if {"" != $dimensions} {
485	if {$dimensions != $dim} {
486	error "don't know how to view sequences of $type\
487	with dimensions as follows:\
488	[$dataobj components -dimensions]"
489	}
490	} else {
491	set dimensions $dim
492	}
493	}
494	set mode [$dataobj viewer]
495	FieldResult $w -mode $mode
496	pack $w -expand yes -fill both
497	}
498	::Rappture::LibraryObj {
499	switch -- [$dataobj element -as type] {
500	structure {
501	Rappture::DeviceResult $w
502	pack $w -expand yes -fill both
503	}
504	default {
505	error "don't know how to view sequences of [$dataobj element -as type]"
506	}
507	}
508	}
509	default {
510	puts stderr "don't know how to view sequences of type \"$type\""
511	puts stderr "Is the sequence empty?"
512	return
513	}
514	}
515	}
516	#
517	# Load the current sequence info the viewer.
518	#
519	$itk_component(indexLabel) configure -text [$_topmost hints indexlabel]
520
521	$w delete
522	$itk_component(dial) clear
523
524	set max [$_topmost size]
525	set all ""
526	for {set i 0} {$i < $max} {incr i} {
527	eval lappend all [$_topmost value $i]
528	}
529	eval $w scale $all
530
531	set _indices ""
532	for {set i 0} {$i < $max} {incr i} {
533	set index [$_topmost index $i]
534	eval $itk_component(dial) add $index
535	lappend _indices [lindex $index 0]
536	}
537	_fixValue
538	}
539
540	# ----------------------------------------------------------------------
541	# USAGE: _playFrame
542	#
543	# Used internally to advance each frame in the animation. Advances
544	# the frame and displays it. When we reach the end of the animation,
545	# we either loop back or stop.
546	# ----------------------------------------------------------------------
547	itcl::body Rappture::SequenceResult::_playFrame {} {
548	global readyForNextFrame
549	if { $readyForNextFrame } {
550	set _pos [expr {$_pos+1}]
551	set last [expr {[llength $_indices]-1}]
552
553	if {$_pos > $last} {
554	if {$_play(loop)} {
555	set _pos 0
556	} else {
557	set _pos $last
558	pause
559	return
560	}
561	}
562	goto $_pos
563	set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
564	} else {
565	set delay 50; # Poll for completion
566	}
567	set _afterId [after $delay [itcl::code $this _playFrame]]
568	}
569
570	# ----------------------------------------------------------------------
571	# USAGE: _fixValue
572	#
573	# Invoked automatically whenever the value on the dial changes.
574	# Updates the viewer to display the value for the selected result.
575	# ----------------------------------------------------------------------
576	itcl::body Rappture::SequenceResult::_fixValue {} {
577	set w $itk_component(area).viewer
578	if {![winfo exists $w]} {
579	return
580	}
581	$w delete
582	if { $_topmost == "" } {
583	return
584	}
585	set val [$itk_component(dial) get -format label current]
586	set _pos [lsearch -glob $_indices $val*]
587
588	# populate the label for this element
589	if { "" != [$_topmost hints indexlabel] } {
590	$itk_component(indexValue) configure -text "= $val"
591	}
592	$itk_component(eleLabel) configure -text "[$_topmost label $_pos]"
593	foreach dataobj [$_topmost value $_pos] {
594	set settings "-color autoreset -width 2"
595	if {[catch {$dataobj hints style} style] == 0} {
596	eval lappend settings $style
597	}
598	if { [catch {$dataobj hints type} type] == 0} {
599	if {"" != $type} {
600	lappend settings -type $type
601	}
602	}
603	$w add $dataobj $settings
604	}
605	}

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

Context Navigation

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

Download in other formats: