private/event.ss
;;; PLT Scheme Simulation Collection
;;; event-imp.ss
;;; Copyright (c) 2004 M. Douglas Williams
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 2.1 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free
;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
;;; 02111-1307 USA.
;;;
;;; -------------------------------------------------------------------
;;;
;;; This file contains the implementations of events and event lists.
;;;
;;; Version  Date      Description
;;; 0.1.0    10/16/04  The initial implemention of events and event
;;;                    lists.  (Doug Williams)

;;; Event structure
;;; An event represents the future execution of a process or procedural
;;; object (primitive event).
(define-struct event
               (time                    ; time the event is to occut
                process                 ; process or #f
                function                ; procedure to be executed
                arguments))             ; arguments for the procedure

;;; Event-list structure
;;; An event list maintains a list of events.  Used to implement the
;;; now and future event lists.
(define-values (struct:event-list
                event-list-constructor
                event-list?
                event-list-field-ref
                set-event-list-field!)
  (make-struct-type 'event-list #f 1 0))

;;; Event List, events field
(define event-list-events
  (make-struct-field-accessor event-list-field-ref 0 'events))

(define set-event-list-events!
  (make-struct-field-mutator set-event-list-field! 0 'events))

;;; make-event-list: -> event-list
(define (make-event-list)
  (event-list-constructor '()))

;;; event-list-empty?: event-list -> boolean
(define (event-list-empty? event-list)
  (eq? (event-list-events event-list) '()))

;;; event-list-add!: event-list x event -> void
;;; Add an event to an event list.  Currently, events are ordered by
;;; time only.
(define (event-list-add! event-list event)
  (let ((events (event-list-events event-list))
        (previous #f))
    (let loop ()
      (if (and (not (eq? events '()))
               (>= (event-time event)
                   (event-time (car events))))
          (begin
            (set! previous events)
            (set! events (cdr events))
            (loop))))
    (if previous
        (set-cdr! previous (cons event events))
        (set-event-list-events! event-list (cons event events)))))

;;; event-list-remove!: event-list x event -> void
(define (event-list-remove! event-list event)
  (let loop ((previous #f)
             (events (event-list-events event-list)))
    (if (not (null? events))
        (if (eq? event (car events))
            (if previous
                (set-cdr! previous (cdr events))
                (set-event-list-events!
                 event-list (cdr events)))
            (loop events (cdr events))))))

;;; event-list-pop!: event-list -> event
;;; Remove and return the next event to be executed from an event list.
(define (event-list-pop! event-list)
  (let* ((events (event-list-events event-list))
         (event (car events)))
    (set-event-list-events! event-list (cdr events))
    event))