private/resource-class.rkt
#lang racket
;;; Racket Simulation Collection
;;; resource-class.rkt
;;; Copyright (c) 2005-2010 M. Douglas Williams
;;;
;;; This file is part of the Racket Simulation Collection.
;;;
;;; The Racket Simulation Collection 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 3 of the License,
;;; or (at your option) any later version.
;;;
;;; The Racket Simulation Collection 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 the Racket Simulation Collection.  If not, see
;;; <http://www.gnu.org/licenses/>.
;;;
;;; -----------------------------------------------------------------------------
;;;
;;; Version  Date      Description
;;; 3.0.0    06/24/08  Updated for V4.0. (MDW)
;;; 3.0.1    11/27/08  Converted to a module. (MDW)
;;; 4.0.0    08/18/10  Converted to Racket. (MDW)

(require "resource.ss"
         "queue.ss")

(define resource%
  (class object%
    (init-field units)
    (define resource #f)
    (define/public request
      (case-lambda
        ((units)
         (resource-request resource units))
        (()
         (resource-request resource))))
    (define/public relinquish
      (case-lambda
        ((units)
         (resource-relinquish resource units))
        (()
         (resource-relinquish resource))))
    (public (int-queue-variable-n queue-variable-n))
    (define (int-queue-variable-n)
      (queue-variable-n (resource-queue resource)))
    (define/public (satisfied-variable-n)
      (queue-variable-n (resource-satisfied resource)))
    (super-new)
    (set! resource (make-resource units))))

(define-syntax define-resource-class
  (syntax-rules ()
    ((define-resource-class (name superclass-expr)
       class-clause
       ...)
     (define name
       (class superclass-expr
         class-clause
         ...
         (inherit-field resource)
         (super-new)
         (set! resource (make-resource units)))))
    ((define-resource-class name
       class-clause
       ...)
     (define-process-class (name resource%)
       class-clause
       ...))))

;;; Module Contracts

(provide (all-defined-out))