;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                         Event Operations                         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Classes

;;; Event class.
(defclass <event> (<keyed-object>)
  ;; the exec slot holds an argument-less function that will do
  ;; something.
  (exec :type      <function>
        :accessor  exec
        :initarg   :exec))

;;; A queue for holding the above objects.
(defclass <event-queue> (<priority-queue>))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Interface

;;; Get the current time.
;;; (define (curent-time) ...)

;;; Inserts the function event at the given delay seconds into the
;;; future.
;;; (define (insert-event delay func) ...)

;;; Inserts an event that is handled as soon as possible.
;;; (define (insert-immediate-event func) ...)

;;; Execute events continuously - this is the main game engine.
;;; (define (event-loop) ...)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Implementation

;;; The global event list - must access using the above interface.
(define *event-queue* (make <event-queue>))

;;; The global time - no interface available so shouldn't be touched.
(define *current-time* 0)

;;; This parameter determines the number of *current-time* units that
;;; represent a single second.  It is not accurate since computation
;;; time is not accounted for.
(define *time-units/sec* 2.0)

;;; Get the current time.
(define (current-time) (/ *current-time* *time-units/sec*))

;;; Increment the current time.
(define (inc-current-time)
  (set! *current-time* (add1 *current-time*)))

;;; Add an event function delay seconds into the future.
(define (insert-event delay func)
  (enqueue (make <event> :key (+ delay (current-time)) :exec func)
           *event-queue*))

;;; Add an immediate event - use the fact that time is always >= 0.
(define (insert-immediate-event func)
  (insert-event 0 func))

;;; Get the next event that should actually happen.
(define (get-pending-event)
  ;; in normal game the queue should never be empty
  (when (empty-queue? *event-queue*)
    ;; go out using an error if all events are done (probably all
    ;; players quit).
    (error "no events left, game done!"))
  (let ((time (key (queue-top *event-queue*))))
    (and (<= time (current-time))
         (dequeue *event-queue*))))

;;; The exec generic function gets an event that is to be executed, now
;;; it is redefined for #f as the case that there is no event - so it
;;; only wait for the next time slot.
(defmethod (exec (event = #f))
  (lambda ()
    (sleep (/ *time-units/sec*))
    (inc-current-time)))

;;; Execute the topmost event function - this is an infinite loop which
;;; drives the whole game.
(define (event-loop)
  ;; this either _does_ something or just waits and increment the time.
  ((exec (get-pending-event)))
  (event-loop))