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


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                  ;;;
;;;                               NOTE                               ;;;
;;;                                                                  ;;;
;;; Exercise 2 of problem set 5 asks you to modify the sources in    ;;;
;;; this file.  Follow the instructions provided by the exercise.    ;;;
;;;                                                                  ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; 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 (current-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 game constructor... starts the selection of game variables
;;; and initializes the event queue
(define *first-events* empty)
(define *reset-events* empty)

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

;;; This parameter determines the number of *current-time* units that
;;; represent a single second.
(define *time-units/sec* 1000.0)

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

;;; 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))

;;; Adds first run events to the first events list
(define (insert-first-event delay func)
  (set! *first-events*
        (append! *first-events* (list (list delay func)))))

;;; Adds a reset event in the case of restarting the game
(define (add-reset-event func)
  (set! *reset-events*
        (cons func *reset-events*)))

;;; Get the next event that should actually happen.
(define (get-pending-event)
  ;; in normal game the queue should never be empty
  (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
;;; waits a bit when no events, or next one didn't arrive yet, this is
;;; not actually needed but doesn't keep using the cpu.
(defmethod (exec (event = #f))
  (thunk (sleep 0.1)))
(defmethod (exec (event <void>))
  (thunk (sleep 0.1)))

(define (terminate-game)
  (reset *event-queue*))

;;; Execute the topmost event function - this is an infinite loop which
;;; drives the whole game.
(define (event-loop)
  ;; If the queue is empty, game is over
  (if (empty-queue? *event-queue*)
    (for-each (lambda (x) (x)) *reset-events*)
    ;; this either _does_ something or just waits and increment the time
    (begin ((exec (get-pending-event)))
           (event-loop))))