1 # nam-ui.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/atobj/nam-ui.tcl,v 1.6 2002/02/03 04:25:26 lim Exp $
32
33
34 Class NamUI
35
36 NamUI instproc init {} {
37 $self instvar refreshTime_ granularity_ updateInt_
38 # refreshTime_ =def= physical time for 1 frame
39 set refreshTime_ 100
40 # granularity_ =def= animation time for 1 frame
41 set granularity_ 2e-3
42 # updateInt_ =def= rate to refresh control messages
43 set updateInt_ [expr $granularity_*5]
44 }
45
46 NamUI instproc attach_view {anmView} {
47
48 $self instvar timeL_ runB_ smoothB_ frameL_ roughtB_ granL_ quitB_
49 $self instvar refreshTime_ view_ pathname_ granT_ timeT_
50
51 $self set view_ $anmView
52 set vpath [$anmView path]
53 set pathname_ [frame $vpath.bf]
54
55 # REVIEW: allow individual buttons to be slapped on independently?
56 set timeT_ [button $pathname_.tt -text " Time:" -relief flat \
57 -activebackground [lindex \
58 [$pathname_ configure -background] 4] \
59 -command "new StackTrace {}"]
60 set timeL_ [label $pathname_.time -text 0.00 -relief ridge]
61 set granT_ [label $pathname_.gt -text " step:"]
62 set granL_ [label $pathname_.gran \
63 -text [concat "step:" [format %.2f \
64 [$self set granularity_]] ms] \
65 -relief ridge]
66 set smoothB_ [button $pathname_.smooth -text "-" -width 1 \
67 -command "$self smoother +10"]
68 set frameL_ [label $pathname_.ft -relief ridge \
69 -text "[format %1.1f [expr 1000./$refreshTime_]] fps"]
70 set roughtB_ [button $pathname_.rough -text "+" -font fixed \
71 -command "$self smoother -10"]
72 set quitB_ [button $pathname_.quit -text Quit -command exit]
73
74 set runB_ [checkbutton $pathname_.run -text " Run " \
75 -indicatoron false -selectcolor gray10 \
76 -command "$self toggleRun"]
77
78
79 $runB_ deselect
80 pack $pathname_ -side bottom -fill x -anchor c
81 $self setup_tSlider
82
83 pack $timeT_ $timeL_ $granT_ $granL_ $smoothB_ \
84 $frameL_ $roughtB_ -side left -fill x
85 pack $quitB_ $runB_ -side right
86
87 bind $vpath <q> exit
88 bind $vpath <Control-c> exit
89 bind $vpath <space> "$self toggleRun"
90 }
91
92 NamUI instproc attach_datasrc {datasrc} {
93 $self instvar datasrc_ timeL_ mintime_ maxtime_ range_
94 set datasrc_ $datasrc
95 $self attach_hooks [$self set view_]
96 $timeL_ configure -text [format %.4f [$datasrc now]]
97 set mintime_ [$datasrc mintime]
98 set maxtime_ [$datasrc maxtime]
99 set range_ [expr $maxtime_ - $mintime_]
100 $self set granularity_ [format %.2f [expr $range_ /2000]]
101 $self setup_sSlider
102 }
103
104 NamUI instproc setup_tSlider {} {
105 $self instvar tSlider_ pathname_ tsPressed_
106
107 set tsPressed_ 0
108 set tSlider_ [scale $pathname_.ts -orient horizontal \
109 -from 0 -to 10000 -relief groove -borderwidth 1 \
110 -showvalue false \
111 -command "$self updateTime"]
112
113 #
114 # We want slightly different semantics. Instead of tracking
115 # the time slider continuously, we just update it when the
116 # button is released. (but we use updateTime to give feedback to the
117 # user
118 # E.g., it takes too long to do a fast-forward each time.
119 #
120 bind $tSlider_ <Button-1> "$self wait"
121 bind $tSlider_ <Button-2> "$self wait"
122
123 bind $tSlider_ <ButtonRelease-1> "$self move2time"
124 bind $tSlider_ <ButtonRelease-2> "$self move2time"
125
126 pack $tSlider_ -side top -fill x
127 }
128
129 NamUI instproc updateTime {x} {
130 $self instvar timeL_ mintime_ maxtime_ tsPressed_
131
132 # update the disply only if slider is pressed
133 if !$tsPressed_ return
134
135 # DbgOut $mintime_ $maxtime_
136 set newtime [expr $mintime_ + ($x/10000.0)*($maxtime_ - $mintime_)]
137 # DbgOut $newtime
138 $timeL_ configure -text [format %.4f $newtime]
139 }
140
141 # suspends the datasrc, so that hook_updateTime won't interfere
142 NamUI instproc wait {} {
143 $self instvar tsPressed_ shouldResume_ datasrc_
144 set tsPressed_ 1
145 set shouldResume_ [$datasrc_ isRunning]
146 if $shouldResume_ {
147 $datasrc_ setRunning 0
148 }
149 }
150
151 NamUI instproc move2time {} {
152 $self instvar tSlider_ mintime_ range_ datasrc_ maxtime_ tsPressed_
153 $self instvar shouldResume_
154 DbgOut end [$tSlider_ get]
155
156 set x [$tSlider_ get]
157 set newtime [expr $mintime_ + ($x/10000.0)*$range_]
158 $datasrc_ reset
159 $datasrc_ setTime $newtime
160 $datasrc_ render_next $newtime
161 if $shouldResume_ {
162 $datasrc_ setRunning 1 $maxtime_
163 }
164 set tsPressed_ 0
165 }
166
167 NamUI instproc display_time {t} {
168 $self instvar timeL_ tSlider_ mintime_ range_ tsPressed_
169 # don't update time if the time slider is pressed (and still held down)
170 if $tsPressed_ return
171 $timeL_ configure -text [format %.4f $t]
172 $tSlider_ set [expr int(10000. * ($t - $mintime_)/$range_)]
173 }
174
175 NamUI instproc setup_sSlider {} {
176 $self instvar sSlider_ view_
177 set fpath [$view_ fpath]
178 set wpath [$view_ wpath]
179 # REVIEW: put this in xresources
180 set min 50
181 set max 6000
182 set sSlider_ [scale $fpath.ss -orient vertical \
183 -from $min -to $max -relief groove -borderwidth 1 \
184 -showvalue false \
185 -command "$self updateGran"]
186 $sSlider_ set [expr int(($min + $max)/2)]
187 bind $sSlider_ <ButtonRelease-1> "$self changeGran"
188 bind $sSlider_ <ButtonRelease-2> "$self changeGran"
189 pack $wpath -side left -fill both -expand 1
190 pack $sSlider_ -side right -fill y
191 }
192
193 NamUI instproc changeGran {} {
194 $self instvar granularity_ sSlider_ range_ granL_ datasrc_
195 # divide the range by 100 to 1000 intervals
196 set x [$sSlider_ get]
197 set granularity_ [format %.4f [expr $range_/($x)]]
198 DbgOut new gran $granularity_
199 $datasrc_ setGran $granularity_
200 $granL_ configure -text "[format %4g [expr $granularity_*1000]] ms"
201 }
202
203 # update only don't change datasrc's granularity as yet
204 NamUI instproc updateGran {x} {
205 DbgOut gran: $x
206 $self instvar granL_ range_
207 set granularity_ [format %.4f [expr $range_/($x)]]
208 DbgOut new gran: $granularity_
209 $granL_ configure -text "[format %4g [expr $granularity_*1000]] ms"
210 }
211
212 NamUI instproc attach_hooks {anmView} {
213 # note the different quotes:
214 # $... is NamUI variables,
215 # \$... refers datasrc variables
216 $self instvar timeL_ datasrc_ runB_
217 $datasrc_ proc hook_updateTime {t} \
218 "$self display_time \$t; \
219 \$self next \$t"
220 $datasrc_ proc hook_stop {t} \
221 "$datasrc_ req_sent_ctrl \{s \$t\}; \
222 $runB_ deselect"
223 }
224
225 NamUI instproc toggleRun {} {
226 $self instvar datasrc_ updateInt_ maxtime_
227 if [$datasrc_ isRunning] {
228 $datasrc_ setRunning 0
229 } else {
230 $datasrc_ setRunning 1 $maxtime_
231 }
232 }
233
234 NamUI instproc smoother {dir} {
235 $self instvar refreshTime_ frameL_ datasrc_
236 if {$refreshTime_ > 11} {
237 set refreshTime_ [expr $refreshTime_ + $dir]
238 $datasrc_ setRefresh $refreshTime_
239 }
240 $frameL_ configure -text "[format %1.1f [expr 1000./$refreshTime_]] fps"
241 }
242
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.