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

Last change on this file since 976 was 976, checked in by dkearney, 17 years ago

decrease the default speed for sequences, this is a temporary patch to allow nanovis and pymol to catch up with the amount of data being sent. it prevents a n oops on the first play of data in sequence results
File size: 18.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    itk_component add options {
119        button $itk_component(player).options -text "Options..." \
120            -padx 1 -pady 0 -relief flat -overrelief raised
121    }
122    grid $itk_component(options) -row 1 -column 2 -sticky sw
123
124    #
125    # Popup option panel
126    #
127    set fn [option get $itk_component(hull) font Font]
128    set bfn [option get $itk_component(hull) boldFont Font]
129
130    Rappture::Balloon $itk_component(hull).popup \
131        -title "Player Settings" -padx 4 -pady 4
132    set inner [$itk_component(hull).popup component inner]
133
134    label $inner.loopl -text "Loop:" -font $bfn
135    grid $inner.loopl -row 0 -column 0 -sticky e
136    radiobutton $inner.loopOn -text "Play once and stop" -font $fn \
137        -variable ::Rappture::SequenceResult::_play(loop) -value 0
138    grid $inner.loopOn -row 0 -column 1 -sticky w
139    radiobutton $inner.loopOff -text "Play continuously" -font $fn \
140        -variable ::Rappture::SequenceResult::_play(loop) -value 1
141    grid $inner.loopOff -row 1 -column 1 -sticky w
142    grid rowconfigure $inner 2 -minsize 8
143
144    label $inner.speedl -text "Speed:" -font $bfn
145    grid $inner.speedl -row 3 -column 0 -sticky e
146    frame $inner.speed
147    grid $inner.speed -row 3 -column 1 -sticky ew
148    label $inner.speed.slowl -text "Slower" -font $fn
149    pack $inner.speed.slowl -side left
150    ::scale $inner.speed.value -from 100 -to 1 \
151        -showvalue 0 -orient horizontal \
152        -variable ::Rappture::SequenceResult::_play(speed)
153    pack $inner.speed.value -side left
154    label $inner.speed.fastl -text "Faster" -font $fn
155    pack $inner.speed.fastl -side left
156
157    $itk_component(options) configure -command \
158        [list $itk_component(hull).popup activate $itk_component(options) above]
159
160    #
161    # Main viewer
162    #
163    itk_component add area {
164        frame $itk_interior.area
165    }
166    pack $itk_component(area) -expand yes -fill both
167
168    eval itk_initialize $args
169}
170
171# ----------------------------------------------------------------------
172# DESTRUCTOR
173# ----------------------------------------------------------------------
174itcl::body Rappture::SequenceResult::destructor {} {
175    pause  ;# stop any animation that might be playing
176}
177
178# ----------------------------------------------------------------------
179# USAGE: add <sequence> ?<settings>?
180#
181# Clients use this to add a data sequence to the viewer.  The optional
182# <settings> are used to configure the display of the data.  Allowed
183# settings are -color, -brightness, -width, -linestyle and -raise.
184# The only setting used here is -raise, which indicates the current
185# object.
186# ----------------------------------------------------------------------
187itcl::body Rappture::SequenceResult::add {dataobj {settings ""}} {
188    array set params {
189        -color auto
190        -brightness 0
191        -width 1
192        -raise 0
193        -linestyle solid
194        -description ""
195        -param ""
196    }
197    foreach {opt val} $settings {
198        if {![info exists params($opt)]} {
199            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
200        }
201        set params($opt) $val
202    }
203
204    if {$params(-raise) && "" == $_topmost} {
205        set _topmost $dataobj
206    }
207    lappend _dlist $dataobj
208
209    $_dispatcher event -idle !rebuild
210}
211
212# ----------------------------------------------------------------------
213# USAGE: get
214#
215# Clients use this to query the list of data objects being displayed,
216# in order from bottom to top of this result.
217# ----------------------------------------------------------------------
218itcl::body Rappture::SequenceResult::get {} {
219    # put the dataobj list in order according to -raise options
220    set dlist $_dlist
221
222    set i [lsearch $_dlist $_topmost]
223    if {$i >= 0} {
224        set dlist [lreplace $dlist $i $i]
225        set dlist [linsert $dlist 0 $_topmost]
226    }
227    return $dlist
228}
229
230# ----------------------------------------------------------------------
231# USAGE: delete ?<dataobj1> <dataobj2> ...?
232#
233# Clients use this to delete a data object from the viewer.  If no
234# data objects are specified, then all data objects are deleted.
235# ----------------------------------------------------------------------
236itcl::body Rappture::SequenceResult::delete {args} {
237    if {[llength $args] == 0} {
238        set args $_dlist
239    }
240
241    # delete all specified curves
242    set changed 0
243    foreach dataobj $args {
244        set pos [lsearch -exact $_dlist $dataobj]
245        if {$pos >= 0} {
246            set _dlist [lreplace $_dlist $pos $pos]
247            set changed 1
248
249            if {$dataobj == $_topmost} {
250                set _topmost ""
251            }
252        }
253    }
254
255    # if anything changed, then rebuild the plot
256    if {$changed} {
257        $_dispatcher event -idle !rebuild
258    }
259}
260
261# ----------------------------------------------------------------------
262# USAGE: scale ?<dataobj1> <dataobj2> ...?
263#
264# Sets the default limits for the overall plot according to the
265# limits of the data for all of the given <dataobj> objects.  This
266# accounts for all data objects--even those not showing on the screen.
267# Because of this, the limits are appropriate for all data objects as
268# the user scans through data in the ResultSet viewer.
269# ----------------------------------------------------------------------
270itcl::body Rappture::SequenceResult::scale {args} {
271    # do nothing
272}
273
274# ----------------------------------------------------------------------
275# USAGE: download coming
276# USAGE: download controls <downloadCommand>
277# USAGE: download now
278#
279# Clients use this method to create a downloadable representation
280# of the plot.  Returns a list of the form {ext string}, where
281# "ext" is the file extension (indicating the type of data) and
282# "string" is the data itself.
283# ----------------------------------------------------------------------
284itcl::body Rappture::SequenceResult::download {option args} {
285    switch $option {
286        coming {
287            return [$itk_component(area).viewer download coming]
288        }
289        controls {
290            return [eval $itk_component(area).viewer download controls $args]
291        }
292        now {
293            if {0} {
294                # produce a movie of results
295                set rval ""
296                if {"" != $_topmost} {
297                    set max [$_topmost size]
298                    set all ""
299                    for {set i 0} {$i < $max} {incr i} {
300                        set dataobj [lindex [$_topmost value $i] 0]
301                        if {[catch {$dataobj tkimage} imh] == 0} {
302                            lappend all $imh
303                        }
304                    }
305                    if {[llength $all] > 0} {
306                        set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
307                        set rval [eval Rappture::icon::gif_animate $delay $all]
308                    }
309                }
310                if {[string length $rval] > 0} {
311                    return [list .gif $rval]
312                }
313                return ""
314            }
315
316            # otherwise, return download of single frame
317            return [$itk_component(area).viewer download now]
318        }
319        default {
320            error "bad option \"$option\": should be coming, controls, now"
321        }
322    }
323}
324
325# ----------------------------------------------------------------------
326# USAGE: play
327#
328# Invoked when the user hits the "play" button to play the current
329# sequence of frames as a movie.
330# ----------------------------------------------------------------------
331itcl::body Rappture::SequenceResult::play {} {
332    # cancel any existing animation
333    pause
334
335    # at the end? then restart fresh
336    if {$_pos >= [llength $_indices]-1} {
337        goto 0
338    }
339
340    # toggle the button to "pause" mode
341    $itk_component(play) configure \
342        -bitmap [Rappture::icon pause] \
343        -command [itcl::code $this pause]
344
345    # schedule the first frame
346    set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
347    set _afterId [after $delay [itcl::code $this _playFrame]]
348}
349
350# ----------------------------------------------------------------------
351# USAGE: pause
352#
353# Invoked when the user hits the "pause" button to stop playing the
354# current sequence of frames as a movie.
355# ----------------------------------------------------------------------
356itcl::body Rappture::SequenceResult::pause {} {
357    if {"" != $_afterId} {
358        catch {after cancel $_afterId}
359        set _afterId ""
360    }
361
362    # toggle the button to "play" mode
363    $itk_component(play) configure \
364        -bitmap [Rappture::icon play] \
365        -command [itcl::code $this play]
366}
367
368# ----------------------------------------------------------------------
369# USAGE: goto ?<index>?
370#
371# Used internally to move the current position of the animation to
372# the frame at a particular <index>.  If the <index> is not specified,
373# then it returns the current position.
374# ----------------------------------------------------------------------
375itcl::body Rappture::SequenceResult::goto {{newval ""}} {
376    if {"" == $newval} {
377        return $_pos
378    }
379    set _pos $newval
380    set val [$itk_component(dial) get -format label @$_pos]
381    $itk_component(dial) current $val
382}
383
384# ----------------------------------------------------------------------
385# USAGE: _rebuild
386#
387# Invoked automatically whenever the data displayed in this viewer
388# changes.  Loads the data from the topmost (current) value into
389# the viewer.
390# ----------------------------------------------------------------------
391itcl::body Rappture::SequenceResult::_rebuild {args} {
392    if {"" == $_topmost && [llength $_dlist] > 0} {
393        set _topmost [lindex $_dlist 0]
394    }
395
396    #
397    # If we have any data, then show the viewer.
398    # Otherwise, hide it.
399    #
400    set viewer $itk_component(area).viewer
401    if {[winfo exists $viewer]} {
402        if {"" == $_topmost} {
403            pack forget $viewer
404            pack forget $itk_component(player)
405            return
406        } else {
407            pack $viewer -expand yes -fill both
408            pack $itk_component(player) -side bottom -fill x
409        }
410    } else {
411        if {"" == $_topmost} {
412            return
413        }
414
415        set type ""
416        if {[$_topmost size] > 0} {
417            set dataobj [lindex [$_topmost value 0] 0]
418            set type [$dataobj info class]
419        }
420        switch -- $type {
421            ::Rappture::Curve {
422                Rappture::XyResult $viewer
423                pack $viewer -expand yes -fill both
424            }
425            ::Rappture::Image {
426                Rappture::ImageResult $viewer
427                pack $viewer -expand yes -fill both
428            }
429            ::Rappture::Field {
430                set dimensions ""
431                set dim ""
432                foreach dim [$dataobj components -dimensions] {
433                    # check to see if the dimensions are the same
434                    # for all elements of the field. i dont think
435                    # we can display fields of differing dimensions
436                    # within the same field object.
437                    if {"" != $dimensions} {
438                        if {$dimensions != $dim} {
439                            error "don't know how to view sequences of $type\
440                                with dimensions as follows:\
441                                [$dataobj components -dimensions]"
442                        }
443                    } else {
444                        set dimensions $dim
445                    }
446                }
447                switch -- $dimensions {
448                    2D {
449                        Rappture::Field2DResult $viewer
450                    }
451                    3D {
452                        Rappture::Field3DResult $viewer
453                    }
454                    default {
455                        error "don't know how to view sequences of $type\
456                            with $dimensions dimensions"
457                    }
458                }
459                pack $viewer -expand yes -fill both
460            }
461            ::Rappture::LibraryObj {
462                switch -- [$dataobj element -as type] {
463                    structure {
464                        Rappture::DeviceResult $viewer
465                        pack $viewer -expand yes -fill both
466                    }
467                    default {
468                        error "don't know how to view sequences of [$dataobj element -as type]"
469                    }
470                }
471            }
472            default {
473                error "don't know how to view sequences of $type"
474            }
475        }
476    }
477
478    #
479    # Load the current sequence info the viewer.
480    #
481    $itk_component(indexLabel) configure -text [$_topmost hints indexlabel]
482
483    $viewer delete
484    $itk_component(dial) clear
485
486    set max [$_topmost size]
487    set all ""
488    for {set i 0} {$i < $max} {incr i} {
489        eval lappend all [$_topmost value $i]
490    }
491    eval $viewer scale $all
492
493    set _indices ""
494    for {set i 0} {$i < $max} {incr i} {
495        set index [$_topmost index $i]
496        eval $itk_component(dial) add $index
497        lappend _indices [lindex $index 0]
498    }
499    _fixValue
500}
501
502# ----------------------------------------------------------------------
503# USAGE: _playFrame
504#
505# Used internally to advance each frame in the animation.  Advances
506# the frame and displays it.  When we reach the end of the animation,
507# we either loop back or stop.
508# ----------------------------------------------------------------------
509itcl::body Rappture::SequenceResult::_playFrame {} {
510    set _pos [expr {$_pos+1}]
511    set last [expr {[llength $_indices]-1}]
512
513    if {$_pos > $last} {
514        if {$_play(loop)} {
515            set _pos 0
516        } else {
517            set _pos $last
518            pause
519            return
520        }
521    }
522    goto $_pos
523
524    set delay [expr {int(ceil(pow($_play(speed)/10.0+2,2.0)*15))}]
525    set _afterId [after $delay [itcl::code $this _playFrame]]
526}
527
528# ----------------------------------------------------------------------
529# USAGE: _fixValue
530#
531# Invoked automatically whenever the value on the dial changes.
532# Updates the viewer to display the value for the selected result.
533# ----------------------------------------------------------------------
534itcl::body Rappture::SequenceResult::_fixValue {} {
535    set viewer $itk_component(area).viewer
536    if {![winfo exists $viewer]} {
537        return
538    }
539
540    set val [$itk_component(dial) get -format label current]
541    $itk_component(indexValue) configure -text "= $val"
542    set _pos [lsearch -glob $_indices $val*]
543
544    $viewer delete
545    if {"" != $_topmost} {
546        foreach dataobj [$_topmost value $_pos] {
547            set settings "-color autoreset -width 2"
548            if {[catch {$dataobj hints style} style] == 0} {
549                eval lappend settings $style
550            }
551            $viewer add $dataobj $settings
552        }
553    }
554}
Note: See TracBrowser for help on using the repository browser.