;;; PLT Scheme Simulation Collection
;;; resource-class.ss
;;; Copyright (c) 2005-2008 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.
;;;
;;; Version  Date      Description
;;; 3.0.0    06/24/08  Updated for V4.0.  (Doug Williams)

(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))))
    (define/public (queue-variable-n)
      (set-variable-n (resource-queue resource)))
    (define/public (satisfied-variable-n)
      (set-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
       ...))))