Context Navigation

source: branches/r9/gui/scripts/sequenceresult.tcl @ 5106

Last change on this file since 5106 was 4170, checked in by ldelgass, 10 years ago
Add missing namespace
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	Rappture::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.

Download in other formats: