Simplify the way systems work

game.scm

@@ -86,6 +86,10 @@
                         (create-system-manager
                          (init-game-systems draw-image context))))
 
+    (pk "System information"
+        "Systems: " (system-manager-systems s-manager)
+        "System-manager proc table" (system-manager-proc-table s-manager))
+
     (write-log! "Creating game")
     (define game (make-game e-manager s-manager 0))
     (define dt (/ 1000.0 60.0))

modules/ces/system-manager.scm

@@ -167,19 +167,35 @@ or false if the input is invalid."
         (vector-map thunk-generator entries))
       (error "Invalid inputs to get-thunks" sys-manager dt)))
 
-(define (run-systems! sys-manager dt)
-  "Executes every valid system."
-  (write-log! "Running system-manager:run-systems!"
-              (system-manager-systems sys-manager))
-  (if (and (system-manager? sys-manager)
-           (list? (system-manager-systems sys-manager)))
-      (let ((thunks (get-thunks sys-manager dt)))
-        (write-log! "Generated thunks" thunks)
-        (vector-for-each (lambda (proc)
-                           (write-log! "Running thunk" proc)
-                           (proc))
-                         thunks))
-      (error "Invalid inputs to run-systems!" sys-manager dt)))
+;; Original system implementation is not working out. Going for a simplier version.
+;; (define (run-systems! sys-manager dt)
+;;  "Executes every valid system."
+;;  (write-log! "Running system-manager:run-systems!"
+;;              (system-manager-systems sys-manager))
+;;  (if (and (system-manager? sys-manager)
+;;           (list? (system-manager-systems sys-manager)))
+;;      (let ((thunks (get-thunks sys-manager dt)))
+;;        (write-log! "Generated thunks" thunks)
+;;        (vector-for-each (lambda (proc)
+;;                           (write-log! "Running thunk" proc)
+;;                           (proc))
+;;                         thunks))
+;;      (error "Invalid inputs to run-systems!" sys-manager dt)))
+
+(define (run-systems! sys-manager entities dt)
+  "Runs the systems in sys-manager on every entitity in entities."
+  (if (system-manager? sys-manager)
+      (let* ((systems (system-manager-systems sys-manager))
+             (entities (if (vector? entities)
+                           (vector->list entities)
+                           entities)))
+        (for-each (lambda (sys)
+                    (run-system-on-entity! sys dt
+                                           (car entities)
+                                           (cdr entities)))
+                  systems))
+      (error "Invalid system-manager passed to system-manager:run-systems!"
+             sys-manager entities dt)))
 
 (define (run-systems-pre-process! sys-manager)
   "Sequentially executes every system's pre-process proceedure,

modules/ces/system.scm

@@ -32,7 +32,8 @@
             system-entity-removed-hook
 
             system-applicable-to-entity?
-            apply-system-to-entity))
+            apply-system-to-entity
+            run-system-on-entity!))
 
 ;; Eventually should work with events as well.
 (define-record-type <system>
@@ -87,3 +88,15 @@ process proceedure."
                          (sys-proc entity dt))))
     (write-log! "System-applied to entity successfully")
     wrapped-proc))
+
+(define (run-system-on-entity! system dt entity . entities)
+  (if (system? system)
+      (unless (null? entity)
+        (let ((run-proc (system-process-entity system))
+              (wants-entity? (system-predicate? system)))
+          (when (wants-entity? entity)
+            (run-proc entity dt))
+          (when (list? entities)
+            (run-system-on-entity! system dt (car entities) (cdr entities)))))
+      (error "Invalid inputs passed to system:run-system-on-entity!"
+             system entity dt)))

modules/ces/system/html-canvas-renderer.scm

@@ -54,17 +54,14 @@
   (when (game-entity? entity)
     (remove-systems-from-entity! (get-system-manager) entity)))
 
-(define (%run-rendering-subsystems! sys-manager dt)
+(define (%run-rendering-subsystems! sys-manager entity dt)
   (let ((sys-manager (get-system-manager)))
     (begin
       (write-log! "Running html-canvas-renderer" dt)
-      (run-systems-pre-process! sys-manager)
-      (run-systems! sys-manager dt)
-      (run-systems-post-process! sys-manager))))
-
-(define (%system-process-proc subsystem-manager entity dt)
-  (%add-entity-to-renderer! subsystem-manager entity)
-  (%run-rendering-subsystems! subsystem-manager dt))
+      ;;(run-systems-pre-process! sys-manager)
+      (run-systems! sys-manager entity dt)
+      ;;(run-systems-post-process! sys-manager)
+      )))
 
 (define (create-html-canvas-renderer draw-function context)
   (write-log! "Running html-canvas-renderer:create-html-canvas-renderer")
@@ -73,7 +70,7 @@
     (create-system wants-entity?
                    (lambda (entity dt)
                      (write-log! "Running html-canvas-renderer")
-                     (%system-process-proc rendering-subsystem-manager
-                                           entity dt))
+                     (%run-rendering-subsystems! rendering-subsystem-manager
+                                                 entity dt))
                    'html-canvas-renderer
                    #:entity-removed-hook %entity-removed-hook)))

modules/game-core.scm

@@ -48,16 +48,18 @@
     (if (and (entity-manager? e-manager)
              (system-manager? s-manager))
         (begin
-          (vector-for-each
-           (lambda (entity)
-             (write-log! "Applying system to entity:" (game-entity-id entity))
-             (if (and (game-entity? entity)
-                      (system-manager? s-manager))
-                 (apply-systems-to-entity! s-manager entity)
-                 (error "Unable to apply systems to entity"
-                        s-manager entity))
-             (write-log! "Applied system to entity:" (game-entity-id entity)))
-           (get-current-entities e-manager))
+          ;; Since we are using a simple iterative system now,
+          ;; we do not need to construct the proc table..
+          ;;(vector-for-each
+          ;; (lambda (entity)
+          ;;   (write-log! "Applying system to entity:" (game-entity-id entity))
+          ;;   (if (and (game-entity? entity)
+          ;;            (system-manager? s-manager))
+          ;;       (apply-systems-to-entity! s-manager entity)
+          ;;       (error "Unable to apply systems to entity"
+          ;;              s-manager entity))
+          ;;   (write-log! "Applied system to entity:" (game-entity-id entity)))
+          ;; (get-current-entities e-manager))
           (write-log! "Initialization complete.")
           (make-game e-manager s-manager 0))
         (error "Game in incorrect state. System manager or entity manager incorrect."
@@ -68,22 +70,19 @@
   (let* ((e-manager (game-entity-manager game))
          (s-manager (game-system-manager game)))
     (write-log! "Running game step" dt)
-    (parameterize ((*logger* pk)
-                   (*entity-manager-parameter* e-manager)
-                   (*system-manager-parameter* s-manager))
+    (parameterize ((*entity-manager-parameter* e-manager))
       (write-log! "system-manager information:"
-                  (system-manager-systems s-manager)
-                  (system-manager-proc-table s-manager))
-      (write-log! "Running pre-process")
-      (run-systems-pre-process! s-manager)
+                  (system-manager-systems s-manager))
+      ;;(write-log! "Running pre-process")
+      ;;(run-systems-pre-process! s-manager)
       (write-log! "Running systems")
-      (run-systems! s-manager dt)
-      (write-log! "Running post-process")
-      (run-systems-post-process! s-manager)
+      (run-systems! s-manager (get-current-entities e-manager) dt)
+      ;;(write-log! "Running post-process")
+      ;;(run-systems-post-process! s-manager)
       (write-log! "Applying systems to entities")
-      (vector-for-each (lambda (entity)
-                         (apply-systems-to-entity! s-manager entity))
-                       (get-updated-entities e-manager))
+      ;;(vector-for-each (lambda (entity)
+      ;;                   (apply-systems-to-entity! s-manager entity))
+      ;;                 (get-updated-entities e-manager))
       (write-log! "Applied systems to entities")
       (let ((next-manager (get-next-generation e-manager)))
         (write-log! "Getting next game")