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

Last change on this file since 608 was 513, checked in by mmc, 18 years ago

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