Context Navigation

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

Last change on this file since 3666 was 3666, checked in by ldelgass, 11 years ago
Fix server list for drawing sequence
File size: 21.1 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	foreach {opt val} $settings {
215	if {![info exists params($opt)]} {
216	error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
217	}
218	set params($opt) $val
219	}
220
221	if {$params(-raise) && "" == $_topmost} {
222	set _topmost $dataobj
223	}
224	lappend _dlist $dataobj
225	$_dispatcher event -idle !rebuild
226	}
227
228	# ----------------------------------------------------------------------
229	# USAGE: get
230	#
231	# Clients use this to query the list of data objects being displayed,
232	# in order from bottom to top of this result.
233	# ----------------------------------------------------------------------
234	itcl::body Rappture::SequenceResult::get {} {
235	# put the dataobj list in order according to -raise options
236	set dlist $_dlist
237
238	set i [lsearch $_dlist $_topmost]
239	if {$i >= 0} {
240	set dlist [lreplace $dlist $i $i]
241	set dlist [linsert $dlist 0 $_topmost]
242	}
243	return $dlist
244	}
245
246	# ----------------------------------------------------------------------
247	# USAGE: delete ?<dataobj1> <dataobj2> ...?
248	#
249	# Clients use this to delete a data object from the viewer. If no
250	# data objects are specified, then all data objects are deleted.
251	# ----------------------------------------------------------------------
252	itcl::body Rappture::SequenceResult::delete {args} {
253	if {[llength $args] == 0} {
254	set args $_dlist
255	}
256	pause
257
258	# delete all specified curves
259	set changed 0
260	foreach dataobj $args {
261	set pos [lsearch -exact $_dlist $dataobj]
262	if {$pos >= 0} {
263	set _dlist [lreplace $_dlist $pos $pos]
264	set changed 1
265
266	if {$dataobj == $_topmost} {
267	set _topmost ""
268	}
269	}
270	}
271
272	# if anything changed, then rebuild the plot
273	if {$changed} {
274	$_dispatcher event -idle !rebuild
275	}
276	}
277
278	# ----------------------------------------------------------------------
279	# USAGE: scale ?<dataobj1> <dataobj2> ...?
280	#
281	# Sets the default limits for the overall plot according to the
282	# limits of the data for all of the given <dataobj> objects. This
283	# accounts for all data objects--even those not showing on the screen.
284	# Because of this, the limits are appropriate for all data objects as
285	# the user scans through data in the ResultSet viewer.
286	# ----------------------------------------------------------------------
287	itcl::body Rappture::SequenceResult::scale {args} {
288	# do nothing
289	}
290
291	# ----------------------------------------------------------------------
292	# USAGE: download coming
293	# USAGE: download controls <downloadCommand>
294	# USAGE: download now
295	#
296	# Clients use this method to create a downloadable representation
297	# of the plot. Returns a list of the form {ext string}, where
298	# "ext" is the file extension (indicating the type of data) and
299	# "string" is the data itself.
300	# ----------------------------------------------------------------------
301	itcl::body Rappture::SequenceResult::download {option args} {
302	if { ![winfo exists $itk_component(area).viewer] } {
303	return ""; # No data, no viewer, no download.
304	}
305	switch $option {
306	coming {
307	return [$itk_component(area).viewer download coming]
308	}
309	controls {
310	return [eval $itk_component(area).viewer download controls $args]
311	}
312	now {
313	if {0} {
314	# produce a movie of results
315	set rval ""
316	if {"" != $_topmost} {
317	set max [$_topmost size]
318	set all ""
319	for {set i 0} {$i < $max} {incr i} {
320	set dataobj [lindex [$_topmost value $i] 0]
321	if {[catch {$dataobj tkimage} imh] == 0} {
322	lappend all $imh
323	}
324	}
325	if {[llength $all] > 0} {
326	set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
327	set rval [eval Rappture::icon::gif_animate $delay $all]
328	}
329	}
330	if {[string length $rval] > 0} {
331	return [list .gif $rval]
332	}
333	return ""
334	}
335	# otherwise, return download of single frame
336	return [eval $itk_component(area).viewer download now $args]
337	}
338	default {
339	error "bad option \"$option\": should be coming, controls, now"
340	}
341	}
342	}
343
344	# ----------------------------------------------------------------------
345	# USAGE: play ?-user\|-program?
346	#
347	# Invoked when the user hits the "play" button to play the current
348	# sequence of frames as a movie.
349	# ----------------------------------------------------------------------
350	itcl::body Rappture::SequenceResult::play {{why -program}} {
351	if { [llength $_indices] == 0 } {
352	return; # No frames (i.e. no data).
353	}
354
355	if {$why eq "-user"} {
356	Rappture::Logger::log sequence play -loop $_play(loop) -speed $_play(speed)
357	}
358
359	# Stop any existing animation.
360	pause
361
362	# At the end? then restart fresh
363	if {$_pos >= [llength $_indices]-1} {
364	goto 0
365	}
366
367	# Toggle the button to "pause" mode
368	$itk_component(play) configure \
369	-bitmap [Rappture::icon pause] \
370	-command [itcl::code $this pause -user]
371
372	global readyForNextFrame
373	set readyForNextFrame 1; # By default, always ready
374	# Schedule the first frame
375	set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
376	set _afterId [after $delay [itcl::code $this _playFrame]]
377	}
378
379	# ----------------------------------------------------------------------
380	# USAGE: pause ?-user\|-program?
381	#
382	# Invoked when the user hits the "pause" button to stop playing the
383	# current sequence of frames as a movie.
384	# ----------------------------------------------------------------------
385	itcl::body Rappture::SequenceResult::pause {{why -program}} {
386	if {$why eq "-user"} {
387	Rappture::Logger::log sequence pause
388	}
389
390	if {"" != $_afterId} {
391	catch {after cancel $_afterId}
392	set _afterId ""
393	}
394	global readyForNextFrame
395	set readyForNextFrame 1; # By default, always ready
396
397	# Check if the play button still exists. We may be in the process
398	# of destroying the widget.
399	if { [info exists itk_component(play)] } {
400	# toggle the button to "play" mode
401	$itk_component(play) configure \
402	-bitmap [Rappture::icon play] \
403	-command [itcl::code $this play -user]
404	}
405	}
406
407	# ----------------------------------------------------------------------
408	# USAGE: goto ?<index>?
409	#
410	# Used internally to move the current position of the animation to
411	# the frame at a particular <index>. If the <index> is not specified,
412	# then it returns the current position.
413	# ----------------------------------------------------------------------
414	itcl::body Rappture::SequenceResult::goto {{newval ""}} {
415	if {"" == $newval} {
416	return $_pos
417	}
418	set _pos $newval
419	set val [$itk_component(dial) get -format label @$_pos]
420	$itk_component(dial) current $val
421	}
422
423	# ----------------------------------------------------------------------
424	# USAGE: _rebuild
425	#
426	# Invoked automatically whenever the data displayed in this viewer
427	# changes. Loads the data from the topmost (current) value into
428	# the viewer.
429	# ----------------------------------------------------------------------
430	itcl::body Rappture::SequenceResult::_rebuild {args} {
431	if {"" == $_topmost && [llength $_dlist] > 0} {
432	set _topmost [lindex $_dlist 0]
433	}
434
435	#
436	# If we have any data, then show the viewer.
437	# Otherwise, hide it.
438	#
439	set w $itk_component(area).viewer
440	if {[winfo exists $w]} {
441	if {"" == $_topmost} {
442	pack forget $w
443	pack forget $itk_component(player)
444	return
445	} else {
446	pack $w -expand yes -fill both
447	pack $itk_component(player) -side bottom -fill x
448	}
449	} else {
450	if {"" == $_topmost} {
451	return
452	}
453
454	set type ""
455	if {[$_topmost size] > 0} {
456	set dataobj [lindex [$_topmost value 0] 0]
457	set type [$dataobj info class]
458	}
459	switch -- $type {
460	::Rappture::Drawing {
461	set servers [Rappture::VisViewer::GetServerList "vtkvis"]
462	Rappture::VtkViewer $w $servers
463	pack $w -expand yes -fill both
464	}
465	::Rappture::Curve {
466	Rappture::XyResult $w
467	pack $w -expand yes -fill both
468	}
469	::Rappture::Histogram {
470	Rappture::HistogramResult $w
471	pack $w -expand yes -fill both
472	}
473	::Rappture::DataTable {
474	Rappture::DataTable $w
475	pack $w -expand yes -fill both
476	}
477	::Rappture::Image {
478	Rappture::ImageResult $w
479	pack $w -expand yes -fill both
480	}
481	::Rappture::Field {
482	set dimensions ""
483	set dim ""
484	foreach dim [$dataobj components -dimensions] {
485	# check to see if the dimensions are the same
486	# for all elements of the field. i dont think
487	# we can display fields of differing dimensions
488	# within the same field object.
489	if {"" != $dimensions} {
490	if {$dimensions != $dim} {
491	error "don't know how to view sequences of $type\
492	with dimensions as follows:\
493	[$dataobj components -dimensions]"
494	}
495	} else {
496	set dimensions $dim
497	}
498	}
499	set mode [$dataobj viewer]
500	switch -- $dimensions {
501	2D {
502	Rappture::Field2DResult $w -mode $mode
503	}
504	3D {
505	Rappture::Field3DResult $w -mode $mode
506	}
507	default {
508	error "don't know how to view sequences of $type\
509	with \"$dimensions\" dimensions dim=[$dataobj components -dimensions]"
510	}
511	}
512	pack $w -expand yes -fill both
513	}
514	::Rappture::LibraryObj {
515	switch -- [$dataobj element -as type] {
516	structure {
517	Rappture::DeviceResult $w
518	pack $w -expand yes -fill both
519	}
520	default {
521	error "don't know how to view sequences of [$dataobj element -as type]"
522	}
523	}
524	}
525	default {
526	puts stderr "don't know how to view sequences of type \"$type\""
527	puts stderr "Is the sequence empty?"
528	return
529	}
530	}
531	}
532	#
533	# Load the current sequence info the viewer.
534	#
535	$itk_component(indexLabel) configure -text [$_topmost hints indexlabel]
536
537	$w delete
538	$itk_component(dial) clear
539
540	set max [$_topmost size]
541	set all ""
542	for {set i 0} {$i < $max} {incr i} {
543	eval lappend all [$_topmost value $i]
544	}
545	eval $w scale $all
546
547	set _indices ""
548	for {set i 0} {$i < $max} {incr i} {
549	set index [$_topmost index $i]
550	eval $itk_component(dial) add $index
551	lappend _indices [lindex $index 0]
552	}
553	_fixValue
554	}
555
556	# ----------------------------------------------------------------------
557	# USAGE: _playFrame
558	#
559	# Used internally to advance each frame in the animation. Advances
560	# the frame and displays it. When we reach the end of the animation,
561	# we either loop back or stop.
562	# ----------------------------------------------------------------------
563	itcl::body Rappture::SequenceResult::_playFrame {} {
564	global readyForNextFrame
565	if { $readyForNextFrame } {
566	set _pos [expr {$_pos+1}]
567	set last [expr {[llength $_indices]-1}]
568
569	if {$_pos > $last} {
570	if {$_play(loop)} {
571	set _pos 0
572	} else {
573	set _pos $last
574	pause
575	return
576	}
577	}
578	goto $_pos
579	set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
580	} else {
581	set delay 50; # Poll for completion
582	}
583	set _afterId [after $delay [itcl::code $this _playFrame]]
584	}
585
586	# ----------------------------------------------------------------------
587	# USAGE: _fixValue
588	#
589	# Invoked automatically whenever the value on the dial changes.
590	# Updates the viewer to display the value for the selected result.
591	# ----------------------------------------------------------------------
592	itcl::body Rappture::SequenceResult::_fixValue {} {
593	set w $itk_component(area).viewer
594	if {![winfo exists $w]} {
595	return
596	}
597	$w delete
598	if { $_topmost == "" } {
599	return
600	}
601	set val [$itk_component(dial) get -format label current]
602	set _pos [lsearch -glob $_indices $val*]
603
604	# populate the label for this element
605	if { "" != [$_topmost hints indexlabel] } {
606	$itk_component(indexValue) configure -text "= $val"
607	}
608	$itk_component(eleLabel) configure -text "[$_topmost label $_pos]"
609	foreach dataobj [$_topmost value $_pos] {
610	set settings "-color autoreset -width 2"
611	if {[catch {$dataobj hints style} style] == 0} {
612	eval lappend settings $style
613	}
614	if { [catch {$dataobj hints type} type] == 0} {
615	if {"" != $type} {
616	lappend settings -type $type
617	}
618	}
619	$w add $dataobj $settings
620	}
621	}

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

Download in other formats: