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