From 56f4d051a3704f75bc1c9653244cd83604ce5449 Mon Sep 17 00:00:00 2001 From: TakeV Date: Sun, 26 May 2024 13:10:48 -0400 Subject: [PATCH] Simplify the way systems work --- game.scm | 4 ++ modules/ces/system-manager.scm | 42 +++++++++++++------ modules/ces/system.scm | 15 ++++++- modules/ces/system/html-canvas-renderer.scm | 17 ++++---- modules/game-core.scm | 45 ++++++++++----------- 5 files changed, 76 insertions(+), 47 deletions(-) diff --git a/game.scm b/game.scm index f87f9ab..24572b7 100644 --- a/game.scm +++ b/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)) diff --git a/modules/ces/system-manager.scm b/modules/ces/system-manager.scm index 863ed33..45f225a 100644 --- a/modules/ces/system-manager.scm +++ b/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, diff --git a/modules/ces/system.scm b/modules/ces/system.scm index ea145c0..b70fea3 100644 --- a/modules/ces/system.scm +++ b/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 @@ -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))) diff --git a/modules/ces/system/html-canvas-renderer.scm b/modules/ces/system/html-canvas-renderer.scm index 901f0b4..7bf4c42 100644 --- a/modules/ces/system/html-canvas-renderer.scm +++ b/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))) diff --git a/modules/game-core.scm b/modules/game-core.scm index 0ae230f..11281ae 100644 --- a/modules/game-core.scm +++ b/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")