~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/mb/ui-timebrowser.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # ui-timebrowser.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1997-2002 The Regents of the University of California.
  6 # All rights reserved.
  7 #
  8 # Redistribution and use in source and binary forms, with or without
  9 # modification, are permitted provided that the following conditions are met:
 10 #
 11 # A. Redistributions of source code must retain the above copyright notice,
 12 #    this list of conditions and the following disclaimer.
 13 # B. Redistributions in binary form must reproduce the above copyright notice,
 14 #    this list of conditions and the following disclaimer in the documentation
 15 #    and/or other materials provided with the distribution.
 16 # C. Neither the names of the copyright holders nor the names of its
 17 #    contributors may be used to endorse or promote products derived from this
 18 #    software without specific prior written permission.
 19 #
 20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
 21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 23 # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
 24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 30 #
 31 #   @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/mb/ui-timebrowser.tcl,v 1.6 2002/02/03 04:27:17 lim Exp $
 32 
 33 import VcrIcons
 34 
 35 Class MBTimeBrowser -superclass MBWidget
 36 
 37 # number of divisions in the slider
 38 MBTimeBrowser set defaultNumSteps_ 100
 39 
 40 # in seconds
 41 MBTimeBrowser set defaultFrameTime_ 1
 42 
 43 # in miliseconds
 44 MBTimeBrowser set defaultRefreshTime_ 500
 45 
 46 MBTimeBrowser instproc init {parent browseVarName} {
 47         $self instvar path_ slider_ stepSlider_ stepLabel_ timeLabel_ \
 48                         pauseBut_ playBut_ sliderRange_ afterId_ revBut_
 49         $self set browseVarName_ $browseVarName
 50         set afterId_ 0
 51         set path_ [frame $parent.ts -relief raised -bd 2]
 52 
 53         set stepSlider_ [scale $path_.stepS -orient horizontal \
 54                         -from 1000 -to 10 -width 10 \
 55                         -showvalue 0 -command "$self update_steps"]
 56         $stepSlider_ set [MBTimeBrowser set defaultNumSteps_]
 57 
 58         set sliderRange_ [MBTimeBrowser set defaultNumSteps_]
 59 
 60         pack $stepSlider_ -side left -anchor s -pady 2
 61         set sliderRange_ 10000
 62         set slider_ [scale $path_.slider -orient horizontal -label Time \
 63                         -from 0 -to $sliderRange_ -resolution 0.05 \
 64                         -showvalue false -command "$self update_label"]
 65 
 66         #
 67         # We want slightly different semantics.  Instead of tracking
 68         # the time slider continuously, we just update it when the
 69         # button is released. (but we use updateTime to give feedback to the
 70         # user
 71         # E.g., it takes too long to do a fast-forward each time.
 72         #
 73         bind $slider_ <Button-1> "$self wait"
 74         bind $slider_ <Button-2> "$self wait"
 75 
 76         bind $slider_ <ButtonRelease-1> "$self move2time"
 77         bind $slider_ <ButtonRelease-2> "$self move2time"
 78 
 79         pack $slider_ -side left -fill x -expand 1
 80 
 81         set timeLabel_ [label $path_.timeL -relief sunken]
 82         set pauseBut_ [button $path_.pauseB -image VcrIcons(pause) \
 83                         -command "$self pause"]
 84         set playBut_ [button $path_.playB -image VcrIcons(play) \
 85                         -command "$self play"]
 86         set revBut_ [button $path_.revB -image VcrIcons(reverse) \
 87                         -command "$self reverse"]
 88         set stopBut_ [button $path_.stopB -image VcrIcons(stop) \
 89                         -command "$self stop"]
 90         pack $pauseBut_ $revBut_ $playBut_ $stopBut_ \
 91                         -side left -fill x -anchor s -padx 2 -pady 4
 92         $self set frameTime_ [MBTimeBrowser set defaultFrameTime_]
 93         $self set refreshTime_ [MBTimeBrowser set defaultRefreshTime_]
 94         $self set running_ 0
 95         $self set shouldResume_ 0
 96 }
 97 
 98 MBTimeBrowser instproc format_time {time {prefix {}}} {
 99         set result [clock format [expr {int($time)}] -format "%%s %I:%M:%S.%%d %p"]
100         set frac [expr {int(($time - int($time))*10)}]
101         return [format $result $prefix $frac]
102 }
103 
104 MBTimeBrowser instproc min_time {time} {
105         $self set mintime_ $time
106 }
107 
108 MBTimeBrowser instproc max_time {time} {
109         $self set maxtime_ $time
110 }
111 
112 MBTimeBrowser instproc update_callBack {cmd} {
113         $self set updateCallBack_ $cmd
114 }
115 
116 MBTimeBrowser instproc stop_callBack {cmd} {
117         $self set stopCallBack_ $cmd
118 }
119 
120 MBTimeBrowser instproc update_slider {time} {
121         $self instvar mintime_ maxtime_ slider_ sliderRange_
122         set x [expr {($time - $mintime_)*$sliderRange_/($maxtime_-$mintime_)}]
123         $slider_ set $x
124         $self update_label $x
125 }
126 
127 MBTimeBrowser instproc update_steps {step} {
128  puts "update_steps $step"
129         $self instvar stepSlider_ mintime_ maxtime_ frameTime_ \
130                         currTime_ slider_
131         set dir [expr {($frameTime_ < 0) ? -1 : 1}]
132         if {[info exists mintime_] && [info exists maxtime_]} {
133                 set frameTime [expr {($maxtime_ - $mintime_)/$step}]
134                 $stepSlider_ configure -label \
135                                 [format "Step: %.2g s" $frameTime]
136                 set frameTime_ [expr {($frameTime_<0) ? -1*$frameTime : $frameTime}]
137                 puts "frametime_ set to $frameTime_, step to $step"
138         }
139 }
140 
141 MBTimeBrowser instproc goto {time} {
142         $self instvar maxtime_ mintime_
143         $self instvar mintime_ maxtime_ slider_ currTime_
144         $self set currTime_ $time
145         $self update_slider $time
146 }
147 
148 MBTimeBrowser instproc set_time {newtime} {
149         $self instvar updateCallBack_
150         $self set currTime_ $newtime
151         eval $updateCallBack_ $newtime
152 }
153 
154 MBTimeBrowser instproc update_label {x} {
155         $self instvar slider_ mintime_ maxtime_ sliderRange_
156         set newtime [expr {$mintime_+($x/$sliderRange_)*($maxtime_-$mintime_)}]
157 #       puts "newtime: $newtime min:$mintime_ max:$maxtime_ x:$x"
158         $slider_ configure -label \
159                         [$self format_time $newtime "Displayed Time:"]
160 }
161 
162 MBTimeBrowser instproc move2time {} {
163         $self instvar slider_ mintime_ maxtime_ shouldResume_ sliderRange_
164         set x [$slider_ get]
165         set newtime [expr {$mintime_ + ($x/$sliderRange_)*($maxtime_-$mintime_)}]
166         $self set_time $newtime
167         if $shouldResume_ {
168                 $self nextFrame
169         }
170 }
171 
172 MBTimeBrowser instproc nextFrame {} {
173         $self instvar currTime_ frameTime_ refreshTime_ running_ afterId_ \
174                         mintime_ maxtime_
175         if {!$running_} {
176                 return
177         }
178         set newTime [expr {$currTime_ + $frameTime_}]
179         if {$newTime > $maxtime_ || $newTime < $mintime_} {
180  puts "stop running: min:$mintime_ max:$maxtime_ new:$newTime"
181                 $self set running_ 0
182         }
183         $self update_slider $newTime
184         $self set_time $newTime
185         if {$running_} {
186                 set afterId_ [after $refreshTime_ "$self nextFrame"]
187         }
188 }
189 
190 MBTimeBrowser instproc play {} {
191         $self instvar frameTime_ currTime_ mintime_
192         $self set running_ 1
193         if {$frameTime_ < 0} {
194                 set frameTime_ [expr {$frameTime_ * -1}]
195         }
196         if {$currTime_ < $mintime_} {
197                 set currTime_ $mintime_
198         }
199         $self nextFrame
200 }
201 
202 MBTimeBrowser instproc reverse {} {
203         $self set running_ 1
204         $self instvar frameTime_ currTime_ maxtime_
205         if {$frameTime_ > 0} {
206                 set frameTime_ [expr {$frameTime_ * -1}]
207         }
208         if {$currTime_ > $maxtime_} {
209                 set currTime_ $maxtime_
210         }
211         $self nextFrame
212 }
213 
214 MBTimeBrowser instproc pause {} {
215         $self set running_ 0
216 }
217 
218 MBTimeBrowser instproc wait {} {
219         set shouldResume_ [$self set running_]
220         $self set running_ 0
221 }
222 
223 MBTimeBrowser instproc stop {} {
224         $self set running_ 0
225         eval [$self set stopCallBack_]
226 }
227 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.