;;;; Copyright 2002, Jonathan Bachrach.  See file TERMS.

(use goo)
(use goo/boot)
(use time/event)
(use time/threads)

(dl %timer-create)
(dl %timer-kill)
(dl %timer-system-time)
(dl %timer-event-time)

(dv <time> <int>)

(dc <timer> (<any>))
  (dp timer-start-time (<timer> => <time>))
  (dp %timer-period (<timer> => <time>))
  (dp timer-callback (<timer> => <fun>)   identity)
  (dp timer-handle (<timer> => <int>)     -1)
  (dp timer-passive? (<timer> => <log>)   #f)
  (dp timer-last-ticks (<timer> => <int>) -1)
  (dp timer-state (<timer> => <sym>)      'stopped)
  (dp timer-event? (<timer> => <log>)     #f)
  (dp timer-event (<timer> => <event>))

(dm timer-stopped? (x|<timer> => <log>)
  (== (timer-state x) 'stopped))

(dm timer-running? (x|<timer> => <log>)
  (== (timer-state x) 'running))

;; (dv t (fab-timer 1000 cb))
;; (timer-start t)

(df cb (x|<timer>) (msg out "TICK %d\n" (timer-ticks x)))
(df timer-dispatcher (x|<timer> max|<int>) 
  (for ((i (below max))) (timer-poll x)))

(dm fab-timer (period|<int> callback|<fun> => <timer>)
  (new <timer> %timer-period period timer-callback callback))

(dm timer-system-time (x|<timer> => <time>)
  (%ib (%timer-system-time)))

(df timer-tick (x|<timer>)
  (fun () ((timer-callback x) x)))

(dm timer-value (x|<timer> => <time>)
  (- (timer-system-time x) (timer-start-time x)))

(dm timer-arm (x|<timer>)
  (unless (timer-passive? x)
    (if (timer-event? x)
        (let ((ev (fab-event 'timer))
               (id (%ib (%timer-event-create 
                         (%iu (timer-period x)) (%lu (event-handle ev))))))
          (set (timer-event x)  ev)
          (set (timer-handle x) id))
        (let ((id (%ib (%timer-create (%iu (timer-period x)) (timer-tick x)))))
          (set (timer-handle x) id))))
  (set (timer-state x) 'running))

(dm timer-start (x|<timer>)
  (unless (timer-running? x)
    (set (timer-start-time x) (timer-system-time x))
    (set (timer-last-ticks x) 0)
    (timer-arm x)))

(dm timer-stop (x|<timer>)
  (unless (timer-stopped? x)
    (unless (timer-passive? x)
      (%timer-kill (%iu (timer-handle x))))
    (set (timer-state x)  'stopped)
    (set (timer-handle x) -1)))

(dm timer-reset (x|<timer>)
  (timer-stop x)
  (timer-start x))

(dv timer-period %timer-period)

(dm timer-period-setter (z|<int> x|<timer>)
  (set (%timer-period x) z)
  (unless (timer-stopped? x)
    (timer-stop x)
    (timer-arm x)))

(dm timer-ticks (x|<timer> => <int>)
  (1st (trunc/ (timer-value x) (timer-period x))))

(dm timer-phase (x|<timer> => <int>)
  (mod (timer-value x) (timer-period x)))

(dm timer-poll (x|<timer> => <log>)
  (and (timer-running? x)
       (> (timer-ticks x) (timer-last-ticks x))
       (seq (set (timer-last-ticks x) (timer-ticks x))
            ((timer-callback x) x)
            #t)))

(dm wait (e|<timer> n|<int> => <log>)
  (wait (timer-event e) n))

(dv test-timer
  (new <timer> timer-period 1000 timer-callback cb timer-passive? #f))

;; (timer-start timer)

(export
  <time>
  <timer>
  timer-period timer-period-setter
  timer-callback
  timer-passive?
  timer-event?
  timer-reset
  timer-start
  timer-stop
  timer-value
  timer-start-time
  timer-poll
  timer-ticks
  timer-phase
  wait)

(export
  %timer-system-time)
