#lang racket/base

(require racket/match)
(require "codec.rkt")
(require "os-big-bang.rkt")
(require "os-udp.rkt")

(provide (struct-out set-timer)
	 (struct-out timer-expired)
	 timer-driver
	 timer-relay)

(struct set-timer (label msecs relative?) #:prefab)
(struct timer-expired (label msecs) #:prefab)

;; Something like this should be part of racket
(define (timer-evt msecs relative?)
  (wrap-evt (alarm-evt (if relative? (+ (current-inexact-milliseconds) msecs) msecs))
	    (lambda (_) (current-inexact-milliseconds))))

(define (timer-driver [self-id 'timer-driver])
  (os-big-bang 'no-state
	       (subscribe 'timer-setter
			  (message-handlers w
			   [(set-timer label msecs relative?)
			    (transition w
			     (subscribe label
					(ground-message-handler w
					 [((list self-id label)
					   (timer-evt msecs relative?)
					   => now)
					  (transition w
					   (unsubscribe label)
					   (send-message (timer-expired label now)))])))]))))

(define (timer-relay [self-id 'timer-relay])
  (os-big-bang 'no-state
	       (subscribe 'timer-relay
			  (message-handlers w
			   [(set-timer label msecs relative?)
			    (transition w
			     (send-meta-message (set-timer (list self-id label) msecs relative?))
			     (subscribe label
					(meta-message-handlers w
					 [(timer-expired (list (== self-id) (== label)) now)
					  (transition w
					   (unsubscribe label)
					   (send-message (timer-expired label now)))])))]))))