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

Open Mash Cross Reference
mash/tcl/atobj/datasrc.tcl

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

  1 # datasrc.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 
 32 #---------------------------------------------------------------------------
 33 # DataSrc
 34 #
 35 Class DataSrc
 36 
 37 DataSrc instproc init {}  {
 38         # defaults to zero, can be set later
 39         $self set firstEId_ 0
 40         $self reset
 41         $self set running_ 0
 42         $self set now_ 0
 43         # should set these values same as animation ui
 44         $self set granularity_ 2e-3
 45         $self set refreshTime_ 100
 46         $self set requestR_ ""
 47         $self set requestId_ 0
 48 }
 49 
 50 # this id is used by Atobj_rcvr to (de)mux among different animations
 51 DataSrc instproc setAnmId {anmId} {
 52         $self set anmId_ $anmId
 53 }
 54 
 55 # set nextEId to firstEId-1 so that the next item we will inspect is firstEId
 56 DataSrc instproc reset {} {
 57         $self set nextEId_ [$self set firstEId_]
 58 }
 59 
 60 DataSrc instproc setNextEId {eventId} {
 61         $self set nextEId_ $eventId
 62 }
 63 
 64 DataSrc instproc attach_view {view} {
 65         $self instvar view_
 66         set view_ $view
 67 }
 68 
 69 DataSrc instproc attach_rcvr {atobj_rcvr} {
 70         $self set atobjRcvr_ $atobj_rcvr
 71 }
 72 
 73 DataSrc instproc mintime {} {
 74         # start at 0 initially
 75         return 0
 76 }
 77 
 78 DataSrc instproc maxtime {} {
 79         return ""
 80 }
 81 
 82 DataSrc instproc handle {eId event} {
 83         $self instvar view_
 84         set type [lindex $event 0]
 85 #        DbgOut $type $event
 86         if {$type=="END"} {
 87                 $self set endTime_ [lindex $event 2]
 88                 return
 89         } elseif {$type=="INIT"} {
 90                 # note: we ignore some of the values, they are there so that
 91                 #       the structure is consistent with the other events...
 92                 foreach {t sT eT fStatic lStatic mintime maxtime bbox} $event {
 93                         $self set lastStatic_ $lStatic
 94                         $self setNextEId [expr $lStatic + 1]
 95                         $self set mintime_ $mintime
 96                         $self set maxtime_ $maxtime
 97                         $self set now_ $mintime
 98                         $view_ setBBox $bbox
 99                         # make view aware of the change in bbox
100                         $view_ resize
101                 }
102 #                puts stderr "INIT received $event"
103                 return
104         }
105         # send up to view by default
106         return [$view_ handle $eId $event]
107 }
108 
109 #
110 # There are 2 versions of advance, one for the dead reckoning stage/local
111 # case, where we want to advance to a point in time, but don't know how much
112 # to move to. We try and advance as much as possible, but if we encounter
113 # events that are not here yet, we stop, request for one event, and wait.
114 #
115 # In the second case (advance_to_eId) we know the limits to move to
116 # (e.g. signal comes thru SRM that specifies dependency). In such case, we
117 # stop also, but look thru the range and request for a range of data.
118 #
119 DataSrc instproc advance {time} {
120         $self instvar view_ firstEId_ events_
121 
122         set nextEId [$self nextEId]
123 
124         if [info exists events_($nextEId)] {
125                 DbgOut advance: t:$time evST: [$self eventST $nextEId] \
126                                 nextEId: $nextEId st=[$self eventST $nextEId]
127         }
128 
129         if {$time > [$self maxtime]} return
130 
131         while {1} {
132                 set event [$self get_event $nextEId]
133                 # DbgOut "event $nextEId is $event"
134                 if {[llength $event]>0} {
135                         # skip over unwanted events
136                         if {[$self inRange $nextEId $time]} {
137                                 DbgOut T=$time ET=[$self eventET $nextEId]
138                                 $self handle $nextEId $event
139                         }
140                 } else {
141                         # since we don't know how much to advance to the given
142                         # time, we stop at the first unseen event (note that
143                         # get_event will trigger the repair request, so in the
144                         # worst case, we proceed one event by one event)
145                         #
146                         # note: this could be due to EOF as well...
147                         return 0
148                 }
149                 if {[$self eventST $nextEId] > $time} {
150                         break
151                 }
152                 incr nextEId
153         }
154         $self setNextEId $nextEId
155         return 1
156 }
157 
158 # same as advance, but this time we advance to an eId
159 # (see comments on advance)
160 DataSrc instproc advance_to_eId {tgtEId t} {
161         $self instvar view_
162         set nextEId [$self nextEId]
163 
164         if {$nextEId > $tgtEId} return
165         set gotAll 1
166         DbgOut atoEId cEId=$nextEId tgtEId=$tgtEId t=$t
167         while {1} {
168                 set event [$self get_event $nextEId]
169 #                DbgOut "atoEID: $nextEId"
170                 if {[llength $event]>0} {
171                         # skip over unwanted events
172                         if {[$self inRange $nextEId $t]} {
173 #                                DbgOut T=$t ET=[$self eventET $nextEId]
174                                 $self handle $nextEId $event
175                         }
176                 } else {
177                         # no data, view_ will get called when repair is here
178                         set gotAll 0
179                         DbgOut "Don't have data $nextEId"
180                 }
181                 if {$nextEId >= $tgtEId} {
182                         break
183                 }
184                 incr nextEId
185         }
186         $self setNextEId $tgtEId
187         return $gotAll
188 }
189 
190 # move the stream to minEventId, and play all active objects til tTgt
191 DataSrc instproc scan {minEId maxEId tTgt} {
192 #        DbgOut "ds scan $tTgt $minEvId $maxEvId"
193         $self set activeR_ [list $minEId $maxEId]
194         $self setNextEId $minEId
195         # REVIEW: should check start and ending time for the events
196         #         for now, treat it as advance
197         if ![$self advance_to_eId $maxEId $tTgt] {
198                 $self next_request
199         }
200         # send requests here?
201 }
202 
203 DataSrc instproc nextEId {} {
204         return [$self set nextEId_]
205 }
206 
207 DataSrc instproc recv_event {args} {
208         # get rid of firs level of braces
209         set args [lindex $args 0]
210         set eId [removeFirst args]
211         $self instvar events_
212         if ![info exists events_($eId)] {
213                 set events_($eId) [lindex $args 0]
214 #                DbgOut "ds194:event $eId set to $events_($eId)"
215 #                $self notify_received $eId
216         }
217         # Is initialization packet and we got it for the first time,
218         # send it up...
219         $self instvar lastStatic_
220         if {$eId == 1 && ![info exists lastStatic_] } {
221                 $self handle $eId $events_($eId)
222                 $self setNextEId 1
223                 $self advance_to_eId $lastStatic_ 0.0
224                 return
225         }
226         if {[info exists lastStatic_] && $eId <= $lastStatic_} {
227                 $self handle $eId $events_($eId)
228                 return
229         }
230 }
231 
232 DataSrc instproc sched_render {msg} {
233         $self instvar renderId_ refreshTime_
234         if [info exists renderId_] {
235                 after cancel $renderId_
236         }
237         set renderId_ [after $refreshTime_ [concat $self render $msg]]
238 }
239 
240 DataSrc instproc recv_ctrl {msg} {
241         set msg [lindex $msg 0]
242         set ctype [removeFirst msg]
243         switch -- $ctype {
244                 s {
245                         # whole message is 'c s time'
246                         # (see NamUI attach_hooks)
247                         $self set endTime_ $msg
248                 }
249                 r {
250                         # whole message is 'c r t min max'
251                         # see DataSrc/Local
252                         DbgOut recv r: $msg
253                         $self sched_render $msg
254                 }
255         }
256 }
257 
258 # REVIEW: should be possible to handle more than one item in one packet...
259 DataSrc instproc recv_ADU {args} {
260         $self instvar events_ view_
261 #        DbgOut "rec_ADU: $args"
262         set pktType [removeFirst args]
263         switch -- $pktType {
264                 # event
265                 e {
266                         $self recv_event $args
267                 }
268                 # control messages: run or stop
269                 c {
270                         $self recv_ctrl $args
271                 }
272         }
273 }
274 
275 #-- callback --#
276 #  returns true if request is still needed, false otherwise
277 DataSrc instproc update_request {requestId} {
278         $self instvar requestR_ atobjRcvr_ requestId_ anmId_
279         set newR [$self find_requestR]
280         set s [lindex $newR 0]
281         set e [lindex $newR 1]
282         set sR [lindex $requestR_ 0]
283         set eR [lindex $requestR_ 1]
284 
285         # if not overlap, we shift onto a new range (cancel_request will
286         # call next_request to update the range)
287         if {$eR < $s || $sR > $e} {
288                 $atobjRcvr_ cancel_request $requestId_ $anmId_ 1
289                 return 0
290         }
291         # overlapping, just update the request
292         set requestR_ $newR
293         return 1
294 }
295 
296 #-- callback --#
297 DataSrc instproc fill_request {requestId len} {
298         # we only keep a single request at a time
299         $self instvar requestId_ requestR_
300         if {$requestId != $requestId_} {
301                 DbgOut f-requ $requestId ignored
302                 return ""
303         }
304         DbgOut "fill_req rid:$requestId l:$len ret:$requestR_"
305         return $requestR_
306 }
307 
308 #--- callback --#
309 # called when an external datasrc wants the data #
310 DataSrc instproc handle_request {args} {
311         set requestR $args
312         if {$args==""}  return
313         DbgOut "r req $requestR"
314         $self instvar replies_ anmId_ atobjRcvr_ events_
315         # only try to answer the reply we have all the data
316         set haveAll 1
317         for {set i [lindex $requestR 0]} {$i<=[lindex $requestR 1]} {incr i} {
318                 if ![info exists events_($i)] {
319                         set haveAll 0
320                         break
321                 }
322         }
323         if {!$haveAll} {
324                 DbgOut ignoring request: $requestR
325                 return
326         }
327 
328         # don't duplicate replies!
329         foreach a [array names replies_] {
330                 set rp $replies_($a)
331                 if {[lindex $requestR 0] <= [lindex $rp 1] && \
332                                 [lindex $requestR 1] >= [lindex $rp 0]} {
333                         DbgOut ignoring request (overlap): $requestR
334                         return
335                 }
336         }
337         $self instvar anmId_
338         set replyId [$atobjRcvr_ sched_reply $anmId_]
339         DbgOut "reply: $replyId scheduled for ( $requestR )"
340         set replies_($replyId) $requestR
341 }
342 
343 DataSrc instproc find_requestR {} {
344         # REVIEW: should check thru all the list of 'future' advance events
345         #         so that we will still send those requests.
346         #    right now we only maintain one active range at a time
347 
348         $self instvar activeR_ events_ lastStatic_ staticR_ view_
349 
350         set aR $activeR_
351         # Always want static
352         # review: should allow multiple requests
353         if $staticR_ {
354                 if ![info exists lastStatic_] {
355                         set aR [list 1 1]
356                 } else {
357                         set aR [list 2 $lastStatic_]
358                 }
359         }
360 
361         DbgOut ar:$aR
362         for {set i [lindex $aR 0]} {$i<=[lindex $aR 1]} {incr i} {
363                 if {![info exists events_($i)] && ![info exists s]} {
364                         # first event
365                         set s $i
366                         continue
367                 }
368                 if {[info exists events_($i)] && [info exists s]} {
369                         break
370                 }
371         }
372         set e [expr $i - 1]
373         # got everyting in the activeRange
374         if ![info exists s] {
375                 if $staticR_ {
376 #                        puts stderr "end static!"
377                         set staticR_ 0
378                         $view_ refresh [$self set now_]
379                         eval $self scan $activeR_ [$self set now_]
380                 }
381                 return ""
382         }
383         return [list $s $e]
384 }
385 
386 # called when activeR_ changes, or when repairs comes in
387 # returns whether current event cancelled
388 DataSrc instproc next_request {} {
389         $self instvar requestR_ atobjRcvr_ requestId_ anmId_
390         set newR [$self find_requestR]
391         DbgOut "nr: newR=$newR, requestR=$requestR_"
392 
393         set s [lindex $newR 0]
394         set e [lindex $newR 1]
395         set eR [lindex $requestR_ 1]
396         set sR [lindex $requestR_ 0]
397         DbgOut nr: $eR $sR
398         # if previous request range does not overlap this new range at
399         # all, cancel it.
400         # note: we set wantcallback to 1 so that next_request will
401         #       not get called recursively.
402         if {"$newR"=="" || ($eR < $s || $sR > $e)} {
403                 if {"$requestR_"!=""} {
404                         $atobjRcvr_ cancel_request $requestId_ $anmId_ 0
405                         $self set requestId_ 0
406                 }
407         }
408         # new request or overlaps
409         set requestR_ $newR
410         DbgOut nr: rr: $requestR_ rId: $requestId_
411         if {"$requestR_"!="" && ($requestId_ == 0)} {
412                 set requestId_ [$atobjRcvr_ sched_request $anmId_]
413                 DbgOut req $requestId_ scheduled
414         }
415 }
416 
417 #-- callback (used from tcl as well) --#
418 # cancel THE current request
419 DataSrc instproc cancel_request {requestId} {
420         $self instvar requestId_ requestR_
421         DbgOut "$requestId"  canncelled
422         DbgAssert [expr $requestId == [$self set requestId_]]
423         set requestR_ ""
424         set requestId_ 0
425         $self next_request
426 }
427 
428 #-- callback --#
429 DataSrc instproc cancel_reply {replyId} {
430         $self instvar replies_ axedRepairs_
431         DbgAssert [info exists replies_($replyId)]
432         unset replies_($replyId)
433         unset axedRepairs_($replyId)
434         DbgOut "reply $replyId cancelled"
435 }
436 
437 #-- callback --#
438 #
439 # Reply format: {$sId $eId} event_{sId} event_{sId+1} .... event_{eId}
440 #
441 DataSrc instproc fill_reply {replyId len} {
442         $self instvar replies_ events_ atobjRcvr_ anmId_ axedRepairs_
443         if ![info exists replies_($replyId)] return
444         if [info exists axedRepairs_($replyId)] return
445         set rRange $replies_($replyId)
446         # -2 for braces
447         set maxlen [expr $len - [string length $rRange] - 2]
448         set reply ""
449         for {set i [lindex $rRange 0]} {$i <= [lindex $rRange 1]} {incr i} {
450                 set newItem [list $i $events_($i)]
451                 if {[string length $reply] + [string len $newItem] + 4 < \
452                                 $maxlen  } {
453                         lappend reply [list $i $events_($i)]
454                 } else {
455                         break
456                 }
457         }
458         incr i -1
459         # one event should never be larger than a packet, for now...
460         DbgAssert [expr $i >= [lindex $rRange 0]]
461         if {$i == [lindex $rRange 1]} {
462                 # note that unset of replies_ elt is done at call back
463                 # REVIEW: keep the reply for a while to suppress...
464                 if ![info exists axedRepairs_($replyId)] {
465                         set axedRepairs_($replyId) [after 100 "$atobjRcvr_ \
466                                         cancel_reply $replyId $anmId_"]
467                 }
468         } else {
469                 # shorten the range
470                 set replies_($replyId) [list [expr $i + 1] [lindex $rRange 1]]
471                 DbgAssert [expr [lindex $replies_($replyId) 1] >= \
472                                 [lindex $replies_($replyId) 0]]
473         }
474         set reply [linsert $reply 0 [list [lindex $rRange 0] $i]]
475         DbgOut "sending reply: [lindex $reply 0]"
476         return $reply
477 }
478 
479 #-- callback --#
480 # if this fullfills request partially, backoff,
481 # if fullfills entirely, cancel
482 DataSrc instproc handle_reply {args} {
483         DbgOut r rpy: [lindex $args 0]
484         $self instvar requestR_ requestId_ atobjRcvr_ anmId_
485         set rRange [removeFirst args]
486         set sId [lindex $rRange 0]
487         set eId [lindex $rRange 1]
488         if {"$requestR_"!=""} {
489                 set sReq [lindex $requestR_ 0]
490                 set eReq [lindex $requestR_ 1]
491                 if {$sId <= $eReq && $eId >= $sReq} {
492                         # overlap
493                         DbgOut "backing off request"
494                         $atobjRcvr_ backoff_request $requestId_
495                         set sR $sReq
496                         set eR $eReq
497                         if {$sId <= $sReq} {
498                                 # overlap on the left
499                                 set sR [expr $eId + 1]
500                         }
501                         if {$eId >= $eReq} {
502                                 # overlap on the right
503                                 set eR [expr $sId - 1]
504                         }
505                         if {$eR < $sR} {
506                                 # note that we will send the next request
507                                 #      in the cancel_request callback
508                                 $atobjRcvr_ cancel_request $requestId_ $anmId_ 1
509                         }
510                 }
511         }
512         $self instvar events_ lastStatic_
513         foreach e $args {
514                 set eId [lindex $e 0]
515 #                DbgOut h rpy $eId
516                 # already got it. ignore duplicate
517                 if [info exists events_($eId)] {
518 #                        DbgOut "h rpy: evt $eId duplicated, ignored"
519                         continue
520                 }
521                 $self recv_event $e
522                 if {[info exists lastStatic_] && $eId <=$lastStatic_} {
523                         # recv_event will send it up.
524 #                        DbgOut "h rpy: evt $eId static, ignored (handled by r evt)"
525                         continue
526                 }
527                 if [$self inRange $eId [$self set now_]] {
528                         $self handle $eId $events_($eId)
529                 } else {
530 #                        DbgOut "h rpy: evt $eId ignored "
531                 }
532         }
533 }
534 
535 # for now, the session announcement is a control msg
536 DataSrc instproc fill_sa {} {
537         $self instvar view_
538         return [list c [list r [$self set now_] \
539                         [$view_ oldestEId] \
540                         [$view_ newestEId]]]
541 }
542 
543 # for now, the session announcement is a control msg
544 DataSrc instproc handle_sa {args} {
545 #        DbgOut SA: $args
546         $self recv_ctrl [list [lindex $args 1]]
547 }
548 
549 # if the datasrc did not get the event, request for repair, and
550 # return NULL
551 DataSrc instproc get_event {eventId} {
552         $self instvar events_
553         if ![info exists events_($eventId)] {
554                 return ""
555         }
556         return $events_($eventId)
557 }
558 
559 #-- hook ----#
560 DataSrc instproc hook_updateTime {t} {}
561 
562 #-- hook ----#
563 DataSrc instproc hook_stop {t} {}
564 
565 DataSrc instproc setRefresh {refreshTime} {
566         $self set refreshTime_ $refreshTime
567 }
568 
569 DataSrc instproc setGran {gran} {
570         $self set granularity_ $gran
571 }
572 
573 # this is called for normal frame by frame movement
574 DataSrc instproc render_next {t} {
575         $self instvar objects_ damage_ datasrc_ view_
576 
577         $self advance $t
578         $view_ update $t
579         $view_ refresh $t
580 }
581 
582 DataSrc instproc setTime {t} {
583         $self set now_ $t
584 }
585 
586 DataSrc instproc next_frame {} {
587         $self instvar now_ granularity_ refreshTime_ running_ endTime_ \
588                         renderId_
589         DbgOut dsnf r= $running_ n=$now_ e=$endTime_
590         if {$now_ < $endTime_} {
591                 $self hook_updateTime $now_
592                 if $running_ {
593                         set now_ [expr $now_ + $granularity_]
594                         $self render_next $now_
595                         if [info exists renderId_] {
596                                 after cancel $renderId_
597                         }
598                         set renderId_ [after $refreshTime_ "$self next_frame"]
599                 }
600         } else {
601                 $self hook_stop $now_
602         }
603 }
604 
605 # moves to a different place in the stream
606 DataSrc instproc render {t minEId maxEId} {
607         # DbgOut "in render: $minEId $maxEId $t"
608         $self instvar now_ view_ renderId_
609 
610         set now_ $t
611         $self hook_updateTime $now_
612 
613         # flush unused data
614         $view_ update $t
615         # {min,max}EId could be null if the page is blank.
616         if {$minEId!="" && $maxEId!=""} {
617                 $self scan $minEId $maxEId $t
618         }
619         $view_ refresh $t
620 }
621 
622 DataSrc instproc now {} {
623         return [$self set now_]
624 }
625 
626 DataSrc instproc isRunning {} {
627         return [$self set running_]
628 }
629 
630 DataSrc instproc setRunning {shouldRun {runPeriod {}}} {
631         $self instvar running_ endTime_ now_
632         if {"$runPeriod"!=""} {
633                 set endTime_ [expr $now_ + $runPeriod]
634         }
635         if {$running_ != $shouldRun} {
636                 set running_ $shouldRun
637                 if $shouldRun {
638                         $self next_frame
639                 }
640         }
641 }
642 
643 DataSrc instproc setup {} {
644         $self instvar staticR_ events_ activeR_
645         if ![info exists events_(1)] {
646                 set activeR_ [list 1 1]
647                 set staticR_ 1
648                 $self next_request
649         }
650 }
651 

~ [ 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.