source: project/release/5/sdl-base/trunk/timer.scm @ 35609

Last change on this file since 35609 was 35609, checked in by megane, 6 months ago

sdl-base: Initial C5 port

File size: 903 bytes
Line 
1;; A heap of timers.
2
3(define-record-type timer
4  (make-timer* time callback)
5  timer?
6  (time timer-time)
7  (callback timer-callback))
8
9(define (timer<=? a b)
10  (<= (timer-time a)
11      (timer-time b)))
12
13(define make-timer-queue
14  (let-values (((timer-heap-insert
15                 timer-heap-merge
16                 timer-heap-delete-minimum)
17                (heap-functor timer<=?)))
18    (lambda (now-fn)
19      (define timers (empty-heap))
20
21      (define (add-timer! time callback)
22        (set! timers (timer-heap-insert (make-timer* time callback) timers)))
23
24      (define (process-queue!)
25        (let ((now (now-fn)))
26          (let loop ()
27            (if (heap-empty? timers)
28                #f
29                (let* ((next (heap-minimum timers))
30                       (delta (- (timer-time next) now)))
31                  (if (positive? delta)
32                      delta
33                      (begin
34                        (set! timers (timer-heap-delete-minimum timers))
35                        ((timer-callback next))
36                        (loop))))))))
37
38      (values add-timer!
39              process-queue!))))
Note: See TracBrowser for help on using the repository browser.