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

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