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

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

Added animated GIF downloads for <sequence> results. Still need
a better way to produce GIFs from the input images. Need to fix
the "blt::winop quantize" operation to avoid external programs
like "djpeg".

Added an example of a <sequence> of <curve> objects as "tool2.xml"
in the zoo/sequence example dir.

File size: 16.2 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}
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    }
194    foreach {opt val} $settings {
195        if {![info exists params($opt)]} {
196            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
197        }
198        set params($opt) $val
199    }
200
201    if {$params(-raise) && "" == $_topmost} {
202        set _topmost $dataobj
203    }
204    lappend _dlist $dataobj
205
206    $_dispatcher event -idle !rebuild
207}
208
209# ----------------------------------------------------------------------
210# USAGE: get
211#
212# Clients use this to query the list of data objects being displayed,
213# in order from bottom to top of this result.
214# ----------------------------------------------------------------------
215itcl::body Rappture::SequenceResult::get {} {
216    # put the dataobj list in order according to -raise options
217    set dlist $_dlist
218
219    set i [lsearch $_dlist $_topmost]
220    if {$i >= 0} {
221        set dlist [lreplace $dlist $i $i]
222        set dlist [linsert $dlist 0 $_topmost]
223    }
224    return $dlist
225}
226
227# ----------------------------------------------------------------------
228# USAGE: delete ?<dataobj1> <dataobj2> ...?
229#
230# Clients use this to delete a data object from the viewer.  If no
231# data objects are specified, then all data objects are deleted.
232# ----------------------------------------------------------------------
233itcl::body Rappture::SequenceResult::delete {args} {
234    if {[llength $args] == 0} {
235        set args $_dlist
236    }
237
238    # delete all specified curves
239    set changed 0
240    foreach dataobj $args {
241        set pos [lsearch -exact $_dlist $dataobj]
242        if {$pos >= 0} {
243            set _dlist [lreplace $_dlist $pos $pos]
244            set changed 1
245
246            if {$dataobj == $_topmost} {
247                set _topmost ""
248            }
249        }
250    }
251
252    # if anything changed, then rebuild the plot
253    if {$changed} {
254        $_dispatcher event -idle !rebuild
255    }
256}
257
258# ----------------------------------------------------------------------
259# USAGE: scale ?<dataobj1> <dataobj2> ...?
260#
261# Sets the default limits for the overall plot according to the
262# limits of the data for all of the given <dataobj> objects.  This
263# accounts for all data objects--even those not showing on the screen.
264# Because of this, the limits are appropriate for all data objects as
265# the user scans through data in the ResultSet viewer.
266# ----------------------------------------------------------------------
267itcl::body Rappture::SequenceResult::scale {args} {
268    # do nothing
269}
270
271# ----------------------------------------------------------------------
272# USAGE: download coming
273# USAGE: download now
274#
275# Clients use this method to create a downloadable representation
276# of the plot.  Returns a list of the form {ext string}, where
277# "ext" is the file extension (indicating the type of data) and
278# "string" is the data itself.
279# ----------------------------------------------------------------------
280itcl::body Rappture::SequenceResult::download {option} {
281    switch $option {
282        coming {
283            # nothing to do
284        }
285        now {
286            set rval ""
287            if {"" != $_topmost} {
288                set max [$_topmost size]
289                set all ""
290                for {set i 0} {$i < $max} {incr i} {
291                    set dataobj [$_topmost value $i]
292                    if {[catch {$dataobj tkimage} imh] == 0} {
293                        lappend all $imh
294                    }
295                }
296                if {[llength $all] > 0} {
297                    set delay [expr {int(ceil(pow($_play(speed)/10.0,2.0)*5))}]
298                    set rval [eval Rappture::icon::gif_animate $delay $all]
299                }
300            }
301            if {[string length $rval] > 0} {
302                return [list .gif $rval]
303            }
304            return ""
305        }
306        default {
307            error "bad option \"$option\": should be coming, now"
308        }
309    }
310}
311
312# ----------------------------------------------------------------------
313# USAGE: play
314#
315# Invoked when the user hits the "play" button to play the current
316# sequence of frames as a movie.
317# ----------------------------------------------------------------------
318itcl::body Rappture::SequenceResult::play {} {
319    # cancel any existing animation
320    pause
321
322    # at the end? then restart fresh
323    if {$_pos >= [llength $_indices]-1} {
324        goto 0
325    }
326
327    # toggle the button to "pause" mode
328    $itk_component(play) configure \
329        -bitmap [Rappture::icon pause] \
330        -command [itcl::code $this pause]
331
332    # schedule the first frame
333    set delay [expr {int(ceil(pow($_play(speed)/10.0,2.0)*5))}]
334    set _afterId [after $delay [itcl::code $this _playFrame]]
335}
336
337# ----------------------------------------------------------------------
338# USAGE: pause
339#
340# Invoked when the user hits the "pause" button to stop playing the
341# current sequence of frames as a movie.
342# ----------------------------------------------------------------------
343itcl::body Rappture::SequenceResult::pause {} {
344    if {"" != $_afterId} {
345        catch {after cancel $_afterId}
346        set _afterId ""
347    }
348
349    # toggle the button to "play" mode
350    $itk_component(play) configure \
351        -bitmap [Rappture::icon play] \
352        -command [itcl::code $this play]
353}
354
355# ----------------------------------------------------------------------
356# USAGE: goto ?<index>?
357#
358# Used internally to move the current position of the animation to
359# the frame at a particular <index>.  If the <index> is not specified,
360# then it returns the current position.
361# ----------------------------------------------------------------------
362itcl::body Rappture::SequenceResult::goto {{newval ""}} {
363    if {"" == $newval} {
364        return $_pos
365    }
366    set _pos $newval
367    set val [$itk_component(dial) get -format value @$_pos]
368    $itk_component(dial) current $val
369}
370
371# ----------------------------------------------------------------------
372# USAGE: _rebuild
373#
374# Invoked automatically whenever the data displayed in this viewer
375# changes.  Loads the data from the topmost (current) value into
376# the viewer.
377# ----------------------------------------------------------------------
378itcl::body Rappture::SequenceResult::_rebuild {args} {
379    if {"" == $_topmost && [llength $_dlist] > 0} {
380        set _topmost [lindex $_dlist 0]
381    }
382
383    #
384    # If we have any data, then show the viewer.
385    # Otherwise, hide it.
386    #
387    set viewer $itk_component(area).viewer
388    if {[winfo exists $viewer]} {
389        if {"" == $_topmost} {
390            pack forget $viewer
391            pack forget $itk_component(player)
392            return
393        } else {
394            pack $viewer -expand yes -fill both
395            pack $itk_component(player) -side bottom -fill x
396        }
397    } else {
398        if {"" == $_topmost} {
399            return
400        }
401
402        set type ""
403        if {[$_topmost size] > 0} {
404            set dataobj [$_topmost value 0]
405            set type [$dataobj info class]
406        }
407        switch -- $type {
408            ::Rappture::Curve {
409                Rappture::XyResult $viewer
410                pack $viewer -expand yes -fill both
411            }
412            ::Rappture::Image {
413                Rappture::ImageResult $viewer
414                pack $viewer -expand yes -fill both
415            }
416            default {
417                error "don't know how to view sequences of $type"
418            }
419        }
420    }
421
422    #
423    # Load the current sequence info the viewer.
424    #
425    $itk_component(indexLabel) configure -text [$_topmost hints indexlabel]
426
427    $viewer delete
428    $itk_component(dial) clear
429
430    set max [$_topmost size]
431    set all ""
432    for {set i 0} {$i < $max} {incr i} {
433        lappend all [$_topmost value $i]
434    }
435    eval $viewer scale $all
436
437    set _indices ""
438    for {set i 0} {$i < $max} {incr i} {
439        set index [$_topmost index $i]
440        set dataobj [$_topmost value $i]
441
442        $viewer add $dataobj ""
443
444        eval $itk_component(dial) add $index
445        lappend _indices [lindex $index 0]
446    }
447    _fixValue
448}
449
450# ----------------------------------------------------------------------
451# USAGE: _playFrame
452#
453# Used internally to advance each frame in the animation.  Advances
454# the frame and displays it.  When we reach the end of the animation,
455# we either loop back or stop.
456# ----------------------------------------------------------------------
457itcl::body Rappture::SequenceResult::_playFrame {} {
458    set _pos [expr {$_pos+1}]
459    set last [expr {[llength $_indices]-1}]
460
461    if {$_pos > $last} {
462        if {$_play(loop)} {
463            set _pos 0
464        } else {
465            set _pos $last
466            pause
467            return
468        }
469    }
470    goto $_pos
471
472    set delay [expr {int(ceil(pow($_play(speed)/10.0,2.0)*5))}]
473    set _afterId [after $delay [itcl::code $this _playFrame]]
474}
475
476# ----------------------------------------------------------------------
477# USAGE: _fixValue
478#
479# Invoked automatically whenever the value on the dial changes.
480# Updates the viewer to display the value for the selected result.
481# ----------------------------------------------------------------------
482itcl::body Rappture::SequenceResult::_fixValue {} {
483    set viewer $itk_component(area).viewer
484    if {![winfo exists $viewer]} {
485        return
486    }
487
488    set val [$itk_component(dial) current]
489    $itk_component(indexValue) configure -text "= $val"
490    set _pos [lsearch $_indices $val]
491
492    $viewer delete
493    if {"" != $_topmost} {
494        set dataobj [$_topmost value $_pos]
495        $viewer add $dataobj "-raise 1"
496    }
497}
Note: See TracBrowser for help on using the repository browser.