source: branches/blt4/gui/scripts/sequenceresult.tcl @ 1719

Last change on this file since 1719 was 1719, checked in by gah, 14 years ago
File size: 19.9 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-*-12-* widgetDefault
23option add *SequenceResult.boldFont \
24    -*-helvetica-bold-r-normal-*-12-* 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 parameters {title args} { # do nothing }
37    public method download {option args}
38
39    public method play {}
40    public method pause {}
41    public method goto {{newval ""}}
42
43    protected method _rebuild {args}
44    protected method _playFrame {}
45    protected method _fixValue {}
46    private method Capture {w h}
47
48    private variable _dispatcher "" ;# dispatcher for !events
49    private variable _dlist ""      ;# list of data objects
50    private variable _topmost ""    ;# topmost data object in _dlist
51    private variable _indices ""    ;# list of active indices
52    private variable _pos 0         ;# current position in the animation
53    private variable _afterId ""    ;# current "after" event for play op
54
55    private common _play            ;# options for "play" operation
56    set _play(speed) 60
57    set _play(loop) 0
58}
59
60itk::usual SequenceResult {
61    keep -background -foreground -cursor -font
62}
63
64# ----------------------------------------------------------------------
65# CONSTRUCTOR
66# ----------------------------------------------------------------------
67itcl::body Rappture::SequenceResult::constructor {args} {
68    Rappture::dispatcher _dispatcher
69    $_dispatcher register !rebuild
70    $_dispatcher dispatch $this !rebuild [itcl::code $this _rebuild]
71
72    option add hull.width hull.height
73    pack propagate $itk_component(hull) no
74
75    itk_component add player {
76        frame $itk_interior.player
77    }
78    pack $itk_component(player) -side bottom -fill x
79    grid columnconfigure $itk_component(player) 1 -weight 1
80
81    itk_component add play {
82        button $itk_component(player).play \
83            -bitmap [Rappture::icon play] \
84            -command [itcl::code $this play]
85    }
86    grid $itk_component(play) -row 0 -rowspan 2 -column 0 \
87        -ipadx 2 -padx {0 4} -pady 4 -sticky nsew
88
89    itk_component add dial {
90        Rappture::Radiodial $itk_component(player).dial \
91            -length 10 -valuewidth 0 -valuepadding 0 -padding 6 \
92            -linecolor "" -activelinecolor "" \
93            -knobimage [Rappture::icon knob2] -knobposition center@middle
94    } {
95        usual
96        keep -dialprogresscolor
97    }
98    grid $itk_component(dial) -row 1 -column 1 -sticky ew
99    bind $itk_component(dial) <<Value>> [itcl::code $this _fixValue]
100
101    itk_component add info {
102        frame $itk_component(player).info
103    }
104    grid $itk_component(info) -row 0 -column 1 -columnspan 2 -sticky ew
105
106    itk_component add indexLabel {
107        label $itk_component(info).ilabel
108    } {
109        usual
110        rename -font -boldfont boldFont Font
111    }
112    pack $itk_component(indexLabel) -side left
113
114    itk_component add indexValue {
115        label $itk_component(info).ivalue -padx 0
116    }
117    pack $itk_component(indexValue) -side left
118
119    # add an element.about.label stanza
120    itk_component add eleLabel {
121        label $itk_component(info).elabel -padx 10
122    }
123    pack $itk_component(eleLabel) -side left
124
125    itk_component add options {
126        button $itk_component(player).options -text "Options..." \
127            -padx 1 -pady 0 -relief flat -overrelief raised
128    }
129    grid $itk_component(options) -row 1 -column 2 -sticky sw
130
131    #
132    # Popup option panel
133    #
134    set fn [option get $itk_component(hull) font Font]
135    set bfn [option get $itk_component(hull) boldFont Font]
136
137    Rappture::Balloon $itk_component(hull).popup \
138        -title "Player Settings" -padx 4 -pady 4
139    set inner [$itk_component(hull).popup component inner]
140
141    label $inner.loopl -text "Loop:" -font $bfn
142    grid $inner.loopl -row 0 -column 0 -sticky e
143    radiobutton $inner.loopOn -text "Play once and stop" -font $fn \
144        -variable ::Rappture::SequenceResult::_play(loop) -value 0
145    grid $inner.loopOn -row 0 -column 1 -sticky w
146    radiobutton $inner.loopOff -text "Play continuously" -font $fn \
147        -variable ::Rappture::SequenceResult::_play(loop) -value 1
148    grid $inner.loopOff -row 1 -column 1 -sticky w
149    grid rowconfigure $inner 2 -minsize 8
150
151    label $inner.speedl -text "Speed:" -font $bfn
152    grid $inner.speedl -row 3 -column 0 -sticky e
153    frame $inner.speed
154    grid $inner.speed -row 3 -column 1 -sticky ew
155    label $inner.speed.slowl -text "Slower" -font $fn
156    pack $inner.speed.slowl -side left
157    ::scale $inner.speed.value -from 100 -to 1 \
158        -showvalue 0 -orient horizontal \
159        -variable ::Rappture::SequenceResult::_play(speed)
160    pack $inner.speed.value -side left
161    label $inner.speed.fastl -text "Faster" -font $fn
162    pack $inner.speed.fastl -side left
163
164    $itk_component(options) configure -command \
165        [list $itk_component(hull).popup activate $itk_component(options) above]
166
167    #
168    # Main viewer
169    #
170    itk_component add area {
171        frame $itk_interior.area
172    }
173    pack $itk_component(area) -expand yes -fill both
174
175    eval itk_initialize $args
176}
177
178# ----------------------------------------------------------------------
179# DESTRUCTOR
180# ----------------------------------------------------------------------
181itcl::body Rappture::SequenceResult::destructor {} {
182    pause  ;# stop any animation that might be playing
183}
184
185# ----------------------------------------------------------------------
186# USAGE: add <sequence> ?<settings>?
187#
188# Clients use this to add a data sequence to the viewer.  The optional
189# <settings> are used to configure the display of the data.  Allowed
190# settings are -color, -brightness, -width, -linestyle and -raise.
191# The only setting used here is -raise, which indicates the current
192# object.
193# ----------------------------------------------------------------------
194itcl::body Rappture::SequenceResult::add {dataobj {settings ""}} {
195    array set params {
196        -color auto
197        -brightness 0
198        -width 1
199        -raise 0
200        -linestyle solid
201        -description ""
202        -param ""
203    }
204    foreach {opt val} $settings {
205        if {![info exists params($opt)]} {
206            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
207        }
208        set params($opt) $val
209    }
210
211    if {$params(-raise) && "" == $_topmost} {
212        set _topmost $dataobj
213    }
214    lappend _dlist $dataobj
215    $_dispatcher event -idle !rebuild
216}
217
218# ----------------------------------------------------------------------
219# USAGE: get
220#
221# Clients use this to query the list of data objects being displayed,
222# in order from bottom to top of this result.
223# ----------------------------------------------------------------------
224itcl::body Rappture::SequenceResult::get {} {
225    # put the dataobj list in order according to -raise options
226    set dlist $_dlist
227
228    set i [lsearch $_dlist $_topmost]
229    if {$i >= 0} {
230        set dlist [lreplace $dlist $i $i]
231        set dlist [linsert $dlist 0 $_topmost]
232    }
233    return $dlist
234}
235
236# ----------------------------------------------------------------------
237# USAGE: delete ?<dataobj1> <dataobj2> ...?
238#
239# Clients use this to delete a data object from the viewer.  If no
240# data objects are specified, then all data objects are deleted.
241# ----------------------------------------------------------------------
242itcl::body Rappture::SequenceResult::delete {args} {
243    if {[llength $args] == 0} {
244        set args $_dlist
245    }
246    pause
247
248    # delete all specified curves
249    set changed 0
250    foreach dataobj $args {
251        set pos [lsearch -exact $_dlist $dataobj]
252        if {$pos >= 0} {
253            set _dlist [lreplace $_dlist $pos $pos]
254            set changed 1
255
256            if {$dataobj == $_topmost} {
257                set _topmost ""
258            }
259        }
260    }
261
262    # if anything changed, then rebuild the plot
263    if {$changed} {
264        $_dispatcher event -idle !rebuild
265    }
266}
267
268# ----------------------------------------------------------------------
269# USAGE: scale ?<dataobj1> <dataobj2> ...?
270#
271# Sets the default limits for the overall plot according to the
272# limits of the data for all of the given <dataobj> objects.  This
273# accounts for all data objects--even those not showing on the screen.
274# Because of this, the limits are appropriate for all data objects as
275# the user scans through data in the ResultSet viewer.
276# ----------------------------------------------------------------------
277itcl::body Rappture::SequenceResult::scale {args} {
278    # do nothing
279}
280
281# ----------------------------------------------------------------------
282# USAGE: download coming
283# USAGE: download controls <downloadCommand>
284# USAGE: download now
285#
286# Clients use this method to create a downloadable representation
287# of the plot.  Returns a list of the form {ext string}, where
288# "ext" is the file extension (indicating the type of data) and
289# "string" is the data itself.
290# ----------------------------------------------------------------------
291itcl::body Rappture::SequenceResult::download {option args} {
292    if { ![winfo exists $itk_component(area).viewer] } {
293        return "";      # No data, no viewer, no download.
294    }
295    switch $option {
296        coming {
297            return [$itk_component(area).viewer download coming]
298        }
299        controls {
300            return [eval $itk_component(area).viewer download controls $args]
301        }
302        now {
303            if {1} {
304                # produce a movie of results
305                if {"" != $_topmost} {
306                    return [Capture 0 0]
307                }
308                return ""
309            } else {
310            # otherwise, return download of single frame
311            return [eval $itk_component(area).viewer download now $args]
312        }
313        }
314        default {
315            error "bad option \"$option\": should be coming, controls, now"
316        }
317    }
318}
319
320# ----------------------------------------------------------------------
321# USAGE: play
322#
323# Invoked when the user hits the "play" button to play the current
324# sequence of frames as a movie.
325# ----------------------------------------------------------------------
326itcl::body Rappture::SequenceResult::play {} {
327    if { [llength $_indices] == 0 } {
328        return;                         # No frames (i.e. no data).
329    }
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,2.0)*15))}]
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                set dimensions ""
429                set dim ""
430                foreach dim [$dataobj components -dimensions] {
431                    # check to see if the dimensions are the same
432                    # for all elements of the field. i dont think
433                    # we can display fields of differing dimensions
434                    # within the same field object.
435                    if {"" != $dimensions} {
436                        if {$dimensions != $dim} {
437                            error "don't know how to view sequences of $type\
438                                with dimensions as follows:\
439                                [$dataobj components -dimensions]"
440                        }
441                    } else {
442                        set dimensions $dim
443                    }
444                }
445                switch -- $dimensions {
446                    2D {
447                        if { [$dataobj isunirect2d] } {
448                            set mode "heightmap"
449                        } else {
450                            set mode "vtk"
451                        }
452                        Rappture::Field2DResult $viewer -mode $mode
453                    }
454                    3D {
455                        Rappture::Field3DResult $viewer
456                    }
457                    default {
458                        error "don't know how to view sequences of $type\
459                            with $dimensions dimensions"
460                    }
461                }
462                pack $viewer -expand yes -fill both
463            }
464            ::Rappture::LibraryObj {
465                switch -- [$dataobj element -as type] {
466                    structure {
467                        Rappture::DeviceResult $viewer
468                        pack $viewer -expand yes -fill both
469                    }
470                    default {
471                        error "don't know how to view sequences of [$dataobj element -as type]"
472                    }
473                }
474            }
475            default {
476                puts stderr "don't know how to view sequences of type \"$type\""
477                puts stderr "Is the sequence empty?"
478                return
479            }
480        }
481    }
482
483    #
484    # Load the current sequence info the viewer.
485    #
486    $itk_component(indexLabel) configure -text [$_topmost hints indexlabel]
487
488    $viewer delete
489    $itk_component(dial) clear
490
491    set max [$_topmost size]
492    set all ""
493    for {set i 0} {$i < $max} {incr i} {
494        eval lappend all [$_topmost value $i]
495    }
496    eval $viewer scale $all
497
498    set _indices ""
499    for {set i 0} {$i < $max} {incr i} {
500        set index [$_topmost index $i]
501        eval $itk_component(dial) add $index
502        lappend _indices [lindex $index 0]
503    }
504    _fixValue
505}
506
507# ----------------------------------------------------------------------
508# USAGE: _playFrame
509#
510# Used internally to advance each frame in the animation.  Advances
511# the frame and displays it.  When we reach the end of the animation,
512# we either loop back or stop.
513# ----------------------------------------------------------------------
514itcl::body Rappture::SequenceResult::_playFrame {} {
515    set _pos [expr {$_pos+1}]
516    set last [expr {[llength $_indices]-1}]
517
518    if {$_pos > $last} {
519        if {$_play(loop)} {
520            set _pos 0
521        } else {
522            set _pos $last
523            pause
524            return
525        }
526    }
527    goto $_pos
528
529    set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
530    set _afterId [after $delay [itcl::code $this _playFrame]]
531}
532
533# ----------------------------------------------------------------------
534# USAGE: _fixValue
535#
536# Invoked automatically whenever the value on the dial changes.
537# Updates the viewer to display the value for the selected result.
538# ----------------------------------------------------------------------
539itcl::body Rappture::SequenceResult::_fixValue {} {
540    set viewer $itk_component(area).viewer
541    if {![winfo exists $viewer]} {
542        return
543    }
544    $viewer delete
545    if { $_topmost == "" } {
546        return
547    }
548    set val [$itk_component(dial) get -format label current]
549    set _pos [lsearch -glob $_indices $val*]
550    # populate the label for this element
551    if { "" != [$_topmost hints indexlabel] } {
552        $itk_component(indexValue) configure -text "= $val"
553    }
554    $itk_component(eleLabel) configure -text "[$_topmost label $_pos]"
555    foreach dataobj [$_topmost value $_pos] {
556        set settings "-color autoreset -width 2"
557        if {[catch {$dataobj hints style} style] == 0} {
558            eval lappend settings $style
559        }
560        $viewer add $dataobj $settings
561    }
562}
563
564# ----------------------------------------------------------------------
565# USAGE: Capture
566#
567# Invoked automatically whenever the value on the dial changes.
568# Updates the viewer to display the value for the selected result.
569# ----------------------------------------------------------------------
570itcl::body Rappture::SequenceResult::Capture {w h} {
571    set viewer $itk_component(area).viewer
572    if {![winfo exists $viewer]} {
573        return
574    }
575    set label [$itk_component(indexLabel) cget -text]
576    set imageList {}
577    update idletasks
578    update
579    set old $_pos
580    for { set i 0 } { $i < [llength $_indices] } { incr i } {
581        goto $i
582        _fixValue
583        update
584        set img [$viewer snap 0 0]
585        $img export gif -file frame$i.gif
586        set value [$itk_component(indexValue) cget -text]
587        if { $value != "" } {
588            $img draw text "$label $value" 10 10 \
589                -font "Arial 10" -color white -shadow 1
590        }
591        lappend imageList $img
592    }
593    goto $old
594    _fixValue
595    update
596    set dest [image create picture]
597    eval $dest list replace 0 end $imageList
598    set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
599    set delay [expr $_play(speed)]
600    $dest export gif -animate -delay $delay -data bytes
601    eval image delete $dest $imageList
602    return [list .gif $bytes]
603}
Note: See TracBrowser for help on using the repository browser.