;;; PLT Scheme Simulation Collection
;;; simulation-environment.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 module implements simulation environments.
;;;
;;; Version  Date      Description
;;; 0.1.0    10/16/04  Initial implementation of simulation
;;;                    environments.  (Doug Williams)
;;; 0.1.1    06/16/05  Added parent and children slots.  (Doug
;;;                    Williams)
;;; 0.1.2    07/11/05  Added continuous simulation. (Doug Williams)
  
;;; The simulation-environment structure
;;; Index  Slot 
;;;   0    running?              #t if the main loop is running
;;;   1    time                  current simulation time
;;;   2    now-event-list        events to be executed now
;;;   3    future-event-list     events to be executed in the future
;;;   4    loop-next             continuation to return to the main loop
;;;   5    loop-exit             continuation to exit the main loop
;;;   6    event                 currently executing event or #f
;;;   7    process               currently executing process or #f
;;; v--- hierarchical environments ----------------------------------v
;;;   8    parent                parent environment
;;;   9    children              list of children environments
;;; v--- continuous simulation --------------------------------------v
;;;   10   continuous-event-list events to be executed continuously
;;;   11   evolve                ode-evolve object
;;;   12   control               ode-control object
;;;   13   step-type             ode-step-type object
;;;   14   step                  ode-step object
;;;   15   system                ode-system-type
;;;   16   step-size             last step-size
;;;   17   dimension             size of the state vector
;;;   18   y                     state vector
;;;   19   dydt                  derivative vector
;;;   20   state-changed?        #t if the state vector needs updating
;;;   21   max-step-size         limit for step-size
(define-values (struct:simulation-environment
                simulation-environment-constructor
                simulation-environment? 
                simulation-environment-field-ref 
                set-simulation-environment-field!)
  (make-struct-type 'simulation-environment #f 22 0))

;;; Simulation environment structure, running? field
(define simulation-environment-running?
  (make-struct-field-accessor
   simulation-environment-field-ref 0 'running?))

(define set-simulation-environment-running?!
  (make-struct-field-mutator
   set-simulation-environment-field! 0 'running?))

;;; Simulation environment structure, time field
(define simulation-environment-time
  (make-struct-field-accessor
   simulation-environment-field-ref 1 'time))

(define set-simulation-environment-time!
  (make-struct-field-mutator
   set-simulation-environment-field! 1 'time))

;;; Simulation environment structure, now-event-list field
(define simulation-environment-now-event-list
  (make-struct-field-accessor
   simulation-environment-field-ref 2 'now-event-list))

(define set-simulation-environment-now-event-list!
  (make-struct-field-mutator
   set-simulation-environment-field! 2 'now-event-list))

;;; Simulation environment structure, future-event-list field
(define simulation-environment-future-event-list
  (make-struct-field-accessor
   simulation-environment-field-ref 3 'future-event-list))

(define set-simulation-environment-future-event-list!
  (make-struct-field-mutator
   set-simulation-environment-field! 3 'future-event-list))

;;; Simulation environment structure, loop-next field
(define simulation-environment-loop-next
  (make-struct-field-accessor
   simulation-environment-field-ref 4 'loop-next))

(define set-simulation-environment-loop-next!
  (make-struct-field-mutator
   set-simulation-environment-field! 4 'loop-next))

;;; Simulation environment structure, loop-exit field
(define simulation-environment-loop-exit
  (make-struct-field-accessor
   simulation-environment-field-ref 5 'loop-exit))

(define set-simulation-environment-loop-exit!
  (make-struct-field-mutator
   set-simulation-environment-field! 5 'loop-exit))

;;; Simulation environment structure, event field
(define simulation-environment-event
  (make-struct-field-accessor
   simulation-environment-field-ref 6 'event))

(define set-simulation-environment-event!
  (make-struct-field-mutator
   set-simulation-environment-field! 6 'event)) 

;;; Simulation environment structure, process field
(define simulation-environment-process
  (make-struct-field-accessor
   simulation-environment-field-ref 7 'process))

(define set-simulation-environment-process!
  (make-struct-field-mutator
   set-simulation-environment-field! 7 'process))

;;; Simulation environment structure, parent field
(define simulation-environment-parent
  (make-struct-field-accessor
   simulation-environment-field-ref 8 'parent))

(define set-simulation-environment-parent!
  (make-struct-field-mutator
   set-simulation-environment-field! 8 'parent))

;;; Simulation environment structure, children field
(define simulation-environment-children
  (make-struct-field-accessor
   simulation-environment-field-ref 9 'children))

(define set-simulation-environment-children!
  (make-struct-field-mutator
   set-simulation-environment-field! 9 'children))

;;; Simulation environment structure, continuous-event-list field
(define simulation-environment-continuous-event-list
  (make-struct-field-accessor
   simulation-environment-field-ref 10 'continuous-event-list))

(define set-simulation-environment-continuous-event-list!
  (make-struct-field-mutator
   set-simulation-environment-field! 10 'continuous-event-list))

;;; Simulation environment structure, evolve field
(define simulation-environment-evolve
  (make-struct-field-accessor
   simulation-environment-field-ref 11 'evolve))

(define set-simulation-environment-evolve!
  (make-struct-field-mutator
   set-simulation-environment-field! 11 'evolve))

;;; Simulation environment structure, control field
(define simulation-environment-control
  (make-struct-field-accessor
   simulation-environment-field-ref 12 'control))

(define set-simulation-environment-control!
  (make-struct-field-mutator
   set-simulation-environment-field! 12 'control))

;;; Simulation environment structure, step-type field
(define simulation-environment-step-type
  (make-struct-field-accessor
   simulation-environment-field-ref 13 'step-type))

(define set-simulation-environment-step-type!
  (make-struct-field-mutator
   set-simulation-environment-field! 13 'step-type))

;;; Simulation environment structure, step field
(define simulation-environment-step
  (make-struct-field-accessor
   simulation-environment-field-ref 14 'step))

(define set-simulation-environment-step!
  (make-struct-field-mutator
   set-simulation-environment-field! 14 'step))

;;; Simulation environment structure, system field
(define simulation-environment-system
  (make-struct-field-accessor
   simulation-environment-field-ref 15 'system))

(define set-simulation-environment-system!
  (make-struct-field-mutator
   set-simulation-environment-field! 15 'system))

;;; Simulation environment structure, step-size field
(define simulation-environment-step-size
  (make-struct-field-accessor
   simulation-environment-field-ref 16 'step-size))

(define set-simulation-environment-step-size!
  (make-struct-field-mutator
   set-simulation-environment-field! 16 'step-size))

;;; Simulation environment structure, dimension field
(define simulation-environment-dimension
  (make-struct-field-accessor
   simulation-environment-field-ref 17 'dimension))

(define set-simulation-environment-dimension!
  (make-struct-field-mutator
   set-simulation-environment-field! 17 'dimension))

;;; Simulation environment structure, y field
(define simulation-environment-y
  (make-struct-field-accessor
   simulation-environment-field-ref 18 'y))

(define set-simulation-environment-y!
  (make-struct-field-mutator
   set-simulation-environment-field! 18 'y))

;;; Simulation environment structure, dydt field
(define simulation-environment-dydt
  (make-struct-field-accessor
   simulation-environment-field-ref 19 'dydt))

(define set-simulation-environment-dydt!
  (make-struct-field-mutator
   set-simulation-environment-field! 19 'dydt))

;;; Simulation environment structure, state-changed? field
(define simulation-environment-state-changed?
  (make-struct-field-accessor
   simulation-environment-field-ref 20 'state-changed?))

(define set-simulation-environment-state-changed?!
  (make-struct-field-mutator
   set-simulation-environment-field! 20 'state-changed?))

;;; Simulation environment structure, max-step-size field
(define simulation-environment-max-step-size
  (make-struct-field-accessor
   simulation-environment-field-ref 21 'max-step-size))

(define set-simulation-environment-max-step-size!
  (make-struct-field-mutator
   set-simulation-environment-field! 21 'max-step-size))

;;; make-simulation-environment: -> simulation-environment
;;; Create and return a new simulation environment
(define make-simulation-environment
  (case-lambda
    ((parent)
     (let ((simulation-environment
            (simulation-environment-constructor
             #f                         ; running?
             0.0                        ; time
             (make-event-list)          ; now-event-list
             (make-event-list)          ; future-event-list
             #f                         ; loop-next
             #f                         ; loop exit
             #f                         ; event
             #f                         ; process
             parent                     ; parent
             '()                        ; children
             (make-event-list)          ; continuous-event-list
             #f                         ; evolve
             (control-y-new 1.0e-6 0.0); control
             rkf45-ode-type             ; step-type
             #f                         ; step
             #f                         ; system
             1.0e-6                     ; step-size
             0                          ; dimension
             #f                         ; y
             #f                         ; dydt
             #t                         ; state-changed?
             +inf.0)))                  ; max-step-size
       (if parent
           (begin
             ;; Add new environemt to parent's children
             (set-simulation-environment-children!
              parent
              (cons simulation-environment
                    (simulation-environment-children parent)))
             ;; Copy the necessary parent slots
             (set-simulation-environment-running?!
              simulation-environment
              (simulation-environment-running? parent))
             (set-simulation-environment-time!
              simulation-environment
              (simulation-environment-time parent))))
       simulation-environment))
    (()
     (make-simulation-environment #f))))

;;; default-simulation-environment
;;; The default simulation environment.
(define default-simulation-environment
  (make-simulation-environment))

;;; current-simulation-environment: -> simulation-environment
;;; current-simulation-environment: simulation-environment -> void
;; Sets or returns the current simulation environment.
(define current-simulation-environment
  (make-parameter default-simulation-environment
                  (lambda (x)
                    (if (not (simulation-environment? x))
                        (raise-type-error 'current-simulation-environment
                                          "simulation-environment" x))
                    x)))

;;; current-simulation-running
(define current-simulation-running?
  (case-lambda
    (()
     (simulation-environment-running?
      (current-simulation-environment)))
    ((running?)
     (set-simulation-environment-running?!
      (current-simulation-environment) running?))))

;;; current-simulation-time
(define current-simulation-time
  (case-lambda
    (()
     (simulation-environment-time
      (current-simulation-environment)))
    ((time)
     (set-simulation-environment-time!
      (current-simulation-environment) time))))

;;; current-simulation-now-event-list
(define current-simulation-now-event-list
  (case-lambda
    (()
     (simulation-environment-now-event-list
      (current-simulation-environment)))
    ((now-event-list)
     (set-simulation-environment-now-event-list!
      (current-simulation-environment) now-event-list))))

;;; future-simulation-future-event-list
(define current-simulation-future-event-list
  (case-lambda
    (()
     (simulation-environment-future-event-list
      (current-simulation-environment)))
    ((future-event-list)
     (set-simulation-environment-future-event-list!
      (current-simulation-environment) future-event-list))))

;;; current-simulation-loop-next
(define current-simulation-loop-next
  (case-lambda
    (()
     (simulation-environment-loop-next
      (current-simulation-environment)))
    ((loop-next)
     (set-simulation-environment-loop-next!
      (current-simulation-environment) loop-next))))

;;; current-simulation-loop-exit
(define current-simulation-loop-exit
  (case-lambda
    (()
     (simulation-environment-loop-exit
      (current-simulation-environment)))
    ((loop-exit)
     (set-simulation-environment-loop-exit!
      (current-simulation-environment) loop-exit))))

;;; current-simulation-event
(define current-simulation-event
  (case-lambda
    (()
     (simulation-environment-event
      (current-simulation-environment)))
    ((event)
     (set-simulation-environment-event!
      (current-simulation-environment) event))))  

;;; current-simulation-process
(define current-simulation-process
  (case-lambda
    (()
     (simulation-environment-process
      (current-simulation-environment)))
    ((process)
     (set-simulation-environment-process!
      (current-simulation-environment) process))))  

;;; current-simulation-parent
(define current-simulation-parent
  (case-lambda
    (()
     (simulation-environment-parent
      (current-simulation-environment)))
    ((parent)
     (set-simulation-environment-parent!
      (current-simulation-environment) parent))))

;;; current-simulation-children
(define current-simulation-children
  (case-lambda
    (()
     (simulation-environment-children
      (current-simulation-environment)))
    ((children)
     (set-simulation-environment-children!
      (current-simulation-environment) children))))

;;; current-simulation-continuous-event-list
(define current-simulation-continuous-event-list
  (case-lambda
    (()
     (simulation-environment-continuous-event-list
      (current-simulation-environment)))
    ((variables)
     (set-simulation-environment-continuous-event-list!
      (current-simulation-environment) variables))))

;;; current-simulation-evolve
(define current-simulation-evolve
  (case-lambda
    (()
     (simulation-environment-evolve
      (current-simulation-environment)))
    ((evolve)
     (set-simulation-environment-evolve!
      (current-simulation-environment) evolve))))

;;; current-simulation-control
(define current-simulation-control
  (case-lambda
    (()
     (simulation-environment-control
      (current-simulation-environment)))
    ((control)
     (set-simulation-environment-control!
      (current-simulation-environment) control))))

;;; current-simulation-step-type
(define current-simulation-step-type
  (case-lambda
    (()
     (simulation-environment-step-type
      (current-simulation-environment)))
    ((step-type)
     (set-simulation-environment-step-type!
      (current-simulation-environment) step-type))))

;;; current-simulation-step
(define current-simulation-step
  (case-lambda
    (()
     (simulation-environment-step
      (current-simulation-environment)))
    ((step)
     (set-simulation-environment-step!
      (current-simulation-environment) step))))

;;; current-simulation-system
(define current-simulation-system
  (case-lambda
    (()
     (simulation-environment-system
      (current-simulation-environment)))
    ((system)
     (set-simulation-environment-system!
      (current-simulation-environment) system))))

;;; current-simulation-step-size
(define current-simulation-step-size
  (case-lambda
    (()
     (simulation-environment-step-size
      (current-simulation-environment)))
    ((step-size)
     (set-simulation-environment-step-size!
      (current-simulation-environment) step-size))))

;;; current-simulation-dimension
(define current-simulation-dimension
  (case-lambda
    (()
     (simulation-environment-dimension
      (current-simulation-environment)))
    ((dimension)
     (set-simulation-environment-dimension!
      (current-simulation-environment) dimension))))

;;; current-simulation-y
(define current-simulation-y
  (case-lambda
    (()
     (simulation-environment-y
      (current-simulation-environment)))
    ((y)
     (set-simulation-environment-y!
      (current-simulation-environment) y))))

;;; current-simulation-dydt
(define current-simulation-dydt
  (case-lambda
    (()
     (simulation-environment-dydt
      (current-simulation-environment)))
    ((dydt)
     (set-simulation-environment-dydt!
      (current-simulation-environment) dydt))))

;;; current-simulation-state-changed?
(define current-simulation-state-changed?
  (case-lambda
    (()
     (simulation-environment-state-changed?
      (current-simulation-environment)))
    ((state-changed?)
     (set-simulation-environment-state-changed?!
      (current-simulation-environment) state-changed?))))

;;; current-simulation-max-step-size?
(define current-simulation-max-step-size
  (case-lambda
    (()
     (simulation-environment-max-step-size
      (current-simulation-environment)))
    ((max-step-size)
     (set-simulation-environment-max-step-size!
      (current-simulation-environment) max-step-size))))

;;; with-simulation-environment
;;; A macro to execute a body of code with a specified simulation
;;; environment as the current-simulation-environment.
(define-syntax with-simulation-environment
  (syntax-rules ()
    ((with-simulation-environment simulation-environment
                                  body ...)
     (parameterize ((current-simulation-environment
                     simulation-environment))
       body ...))))

;;; with-new-simulation-environment
;;; A macro to execute a body of code with a newly created simulation
;; environment as the current-simulation-environment.
(define-syntax with-new-simulation-environment
  (syntax-rules ()
    ((with-new-simulation-environment
      body ...)
     (parameterize ((current-simulation-environment
                     (make-simulation-environment)))
       body ...))))