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

Last change on this file since 644 was 644, checked in by nkissebe, 18 years ago

sequence.tcl,sequenceresult.tcl: add support for molecule structure sequences
File size: 17.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 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            ::Rappture::LibraryObj {
432                switch -- [$dataobj element -as type] {
433                    structure {
434                        Rappture::DeviceResult $viewer
435                        pack $viewer -expand yes -fill both
436                    }
437                    default {
438                        error "don't know how to view sequences of [$dataobj element -as type]"
439                    }
440                }
441            }
442            default {
443                error "don't know how to view sequences of $type"
444            }
445        }
446    }
447
448    #
449    # Load the current sequence info the viewer.
450    #
451    $itk_component(indexLabel) configure -text [$_topmost hints indexlabel]
452
453    $viewer delete
454    $itk_component(dial) clear
455
456    set max [$_topmost size]
457    set all ""
458    for {set i 0} {$i < $max} {incr i} {
459        eval lappend all [$_topmost value $i]
460    }
461    eval $viewer scale $all
462
463    set _indices ""
464    for {set i 0} {$i < $max} {incr i} {
465        set index [$_topmost index $i]
466        eval $itk_component(dial) add $index
467        lappend _indices [lindex $index 0]
468    }
469    _fixValue
470}
471
472# ----------------------------------------------------------------------
473# USAGE: _playFrame
474#
475# Used internally to advance each frame in the animation.  Advances
476# the frame and displays it.  When we reach the end of the animation,
477# we either loop back or stop.
478# ----------------------------------------------------------------------
479itcl::body Rappture::SequenceResult::_playFrame {} {
480    set _pos [expr {$_pos+1}]
481    set last [expr {[llength $_indices]-1}]
482
483    if {$_pos > $last} {
484        if {$_play(loop)} {
485            set _pos 0
486        } else {
487            set _pos $last
488            pause
489            return
490        }
491    }
492    goto $_pos
493
494    set delay [expr {int(ceil(pow($_play(speed)/10.0,2.0)*5))}]
495    set _afterId [after $delay [itcl::code $this _playFrame]]
496}
497
498# ----------------------------------------------------------------------
499# USAGE: _fixValue
500#
501# Invoked automatically whenever the value on the dial changes.
502# Updates the viewer to display the value for the selected result.
503# ----------------------------------------------------------------------
504itcl::body Rappture::SequenceResult::_fixValue {} {
505    set viewer $itk_component(area).viewer
506    if {![winfo exists $viewer]} {
507        return
508    }
509
510    set val [$itk_component(dial) get -format label current]
511    $itk_component(indexValue) configure -text "= $val"
512    set _pos [lsearch -glob $_indices $val*]
513
514    $viewer delete
515    if {"" != $_topmost} {
516        foreach dataobj [$_topmost value $_pos] {
517            $viewer add $dataobj ""
518        }
519    }
520}
Note: See TracBrowser for help on using the repository browser.