From 1ff5a8e94ed4ef271d7ec0d39773d4eefa6bc9de Mon Sep 17 00:00:00 2001
From: TakeV <takev@disroot.org>
Date: Sat, 25 May 2024 22:50:05 -0400
Subject: [PATCH] Working entity-manager setup

---
 game.scm                          | 26 ++++++++++----------
 modules/ces/component.scm         |  8 +++++--
 modules/ces/entity-manager.scm    | 40 +++++++++++++++++--------------
 modules/ces/entity.scm            | 21 +++++++++++-----
 modules/ces/entity/entity-map.scm | 21 +++++++++-------
 modules/game/game-manager.scm     | 29 ++++++++++++----------
 modules/game/game-objects.scm     | 20 +++++++++-------
 modules/game/level-manager.scm    | 16 +++++--------
 modules/lib/ihashtable.scm        | 34 ++++++++++++++++++--------
 9 files changed, 126 insertions(+), 89 deletions(-)

diff --git a/game.scm b/game.scm
index 557f3e4..cd39e1e 100644
--- a/game.scm
+++ b/game.scm
@@ -56,26 +56,26 @@
 (define game-width 640.0)
 (define game-height 480.0)
 
-(define game-images `(('player . ,(make-image "assets/sprites/player.png"))
-                      ('barrel . ,(make-image "assets/sprites/barrel.png"))
-                      ('bricks . ,(make-image "assets/sprites/bricks.png"))
-                      ('stones . ,(make-image "assets/sprites/stones.png"))
-                      ('card-back . ,(make-image "assets/sprites/bricks.png"))
-                      ('tile-blank . ,(make-image "assets/tiles/blank.png"))
-                      ('tile-floor . ,(make-image "assets/tiles/floor-light.png"))
-                      ('tile-wall . ,(make-image "assets/tiles/bricks-light.png"))
-                      ('tile-door . ,(make-image "assets/tiles/door-light.png"))))
+(define game-images `((player . ,(make-image "assets/sprites/player.png"))
+                      (barrel . ,(make-image "assets/sprites/barrel.png"))
+                      (bricks . ,(make-image "assets/sprites/bricks.png"))
+                      (stones . ,(make-image "assets/sprites/stones.png"))
+                      (card-back . ,(make-image "assets/sprites/bricks.png"))))
 
 (parameterize ((*logger* pk))
   (parameterize ((*media-library* (create-media-library)))
     (add-images! (get-media-library) game-images)
 
-    (define bootstrap-entity-manager (make-parameter #f))
-    (define bootstrap-system-manager (make-parameter #f))
+    (write-log! "Creating bootstrap managers")
+    (define bootstrap-entity-manager (create-entity-manager))
+    (define bootstrap-system-manager (create-entity-manager))
     (write-log! "Creating entity manager")
     (define e-manager (parameterize ((*entity-manager-parameter* bootstrap-entity-manager)
                                      (*system-manager-parameter* bootstrap-system-manager))
-                        (create-entity-manager (pk (init-game-entities)))))
+                        (write-log! "Entering e-manager creation")
+                        (let ((init-entities (init-game-entities)))
+                          (write-log! "Got initial game entities.")
+                          (create-entity-manager init-entities))))
 
     (write-log! "Creating system manager")
     (define s-manager
@@ -98,7 +98,7 @@
 
     (write-log! "Defining game loop.")
     (define (update-game-loop)
-      (parameterize ((*logger* pk))
+      (parameterize ((*logger* #f))
         (write-log! "Heartbeat")
         (let* ((last-game-state (atomic-box-ref game-atom))
                (next-game-state (step-game! last-game-state dt)))
diff --git a/modules/ces/component.scm b/modules/ces/component.scm
index 68eb199..4cb32c6 100644
--- a/modules/ces/component.scm
+++ b/modules/ces/component.scm
@@ -14,6 +14,7 @@
   #:use-module (hoot hashtables)
   #:use-module (ces entity)
   #:use-module (lib ihashtable)
+  #:use-module (logging)
   #:export (set-component
             get-component
             remove-component
@@ -30,12 +31,15 @@ or false if the component is not found."
 (define (set-component entity component-name component)
   "Returns a new instance of entity with component-name set to component.
 Returns false entity is not a game-entity."
+  (write-log! "Running component:set-component" component-name)
   (if (game-entity? entity)
       (let ((old-components (get-entity-components entity)))
         (set-entity-components entity
                                (ihashtable-assoc old-components
                                                  component-name
-                                                 component)))))
+                                                 component)))
+      (error "Invalid entity passed to component:set-component"
+             entity component-name component)))
 
 (define (update-component entity component-name update-proc)
   "Returns a new instance of entity with component-name set to the result
@@ -46,7 +50,7 @@ Returns #f if entity is not a game-entity or if component-name does not exists."
       (set-component entity component-name
                      (update-proc component-name
                                   (get-component entity component-name)))
-      #f))
+      (error "Invalid parameters passed to update-component" entity component-name update-proc)))
 
 (define (remove-component entity component-name)
   "Returns a copy of entity with component-name removed.
diff --git a/modules/ces/entity-manager.scm b/modules/ces/entity-manager.scm
index 5192200..d993815 100644
--- a/modules/ces/entity-manager.scm
+++ b/modules/ces/entity-manager.scm
@@ -14,6 +14,7 @@
   #:use-module (hoot hashtables)
   #:use-module (hoot debug)
   #:use-module (hoot match)
+  #:use-module ((hoot write) #:select (display))
   #:use-module (scheme base)
   #:use-module (scheme case-lambda)
   #:use-module (ces entity)
@@ -42,6 +43,12 @@
   (next-entities entity-manager-next-entities)
   (entities-to-delete entity-manager-deleted-entities))
 
+(define (%em-printer em)
+  (entity-manager-current-entities em)
+  (entity-manager-next-entities em)
+  (entity-manager-deleted-entities em)
+  (entity-generator em))
+
 (define create-entity-manager
   (case-lambda
     (() (create-entity-manager (emap:create-entity-map)))
@@ -91,16 +98,14 @@ an integer."
   (if (entity-manager? entity-manager)
       (values (entity-manager-current-entities entity-manager)
               (entity-manager-next-entities entity-manager)
-              (entity-manager-deleted-entities entity-manager))))
+              (entity-manager-deleted-entities entity-manager))
+      (error "Invalid entity-manager passed to %get-em-fields")))
 
 (define (add-entity! entity-manager entity)
   "Adds an entity to the next generation."
   (begin
-    (write-log! "Adding entity:")
     (when (%valid-em-inputs? entity-manager entity)
       (let ((entity-id (game-entity-id entity)))
-        (write-log! (string-append "Adding entity id: "
-                                   (number->string entity-id)))
         (let-values (((cur add up del)
                       (%get-em-state-list entity-manager entity))
                      ((em-cur em-next em-del)
@@ -114,8 +119,9 @@ add the entity to the next generation, just creates one with a valid
 entity-id. Use 'add-entity!' to add it to the game.
 Returns false if the entity-manager is not an entity-manager"
   (if (entity-manager? entity-manager)
-      ((entity-generator entity-manager))
-      #f))
+      (begin
+        ((entity-generator entity-manager)))
+      (error "Invalid entity-manager for create-entity!" entity-manager)))
 
 (define (delete-entity! entity-manager entity)
   "Deletes the entity from the next generation."
@@ -135,16 +141,15 @@ Returns false if the entity-manager is not an entity-manager"
 
 (define (reset-entity! entity-manager entity)
   "Replaces an entity, either adding it or updating it in the next gen."
-  (when (and (%valid-em-inputs? entity-manager entity)
-             (game-entity? entity))
-    (let ((entity-id (game-entity-id entity)))
-      (let-values (((cur add upt del)
-                    (%get-em-state-list entity-manager entity))
-                   ((em-cur em-next em-del)
-                    (%get-em-fields entity-manager)))
-        (when del
-          (emap:delete-entity! em-del entity))
-        (emap:set-entity! em-next entity-id entity)))))
+  (when (%valid-em-inputs? entity-manager entity)
+    (let-values ((entity-id (game-entity-id entity))
+                 ((cur add upt del)
+                  (%get-em-state-list entity-manager entity))
+                 ((em-cur em-next em-del)
+                  (%get-em-fields entity-manager)))
+      (when del
+        (emap:delete-entity! em-del entity))
+      (emap:set-entity! em-next entity-id entity))))
 
 (define (apply-update-to-entity! entity-manager entity proc)
   "Applies proc to the given entity, and stores the result
@@ -160,8 +165,7 @@ Returns false if the entity does not exist."
 
 (define (get-current-entities entity-manager)
   "Returns a vector of every current entity."
-  (begin (write-log! "Getting entities from entity-manager")
-         (emap:get-entity-map-entities (entity-manager-current-entities entity-manager))))
+  (emap:get-entity-map-entities (entity-manager-current-entities entity-manager)))
 
 (define (get-updated-entities entity-manager)
   "Returns a vector of the updated-entities"
diff --git a/modules/ces/entity.scm b/modules/ces/entity.scm
index 340ad0a..16e4e43 100644
--- a/modules/ces/entity.scm
+++ b/modules/ces/entity.scm
@@ -7,9 +7,11 @@
   #:use-module (scheme base)
   #:use-module (scheme case-lambda)
   #:use-module (hoot atomics)
+  #:use-module (hoot debug)
   #:use-module (hoot hashtables)
   #:use-module (hoot match)
   #:use-module (lib ihashtable)
+  #:use-module (logging)
   #:export (game-entity?
             game-entity-id
             create-entity
@@ -27,31 +29,37 @@
 
 (define create-entity
   (case-lambda
-    ((id) (create-entity id (ihashtable)))
+    ((id) (create-entity id (create-ihashtable)))
     ((id components)
-     (make-game-entity id (ihashtable components)))))
+     (make-game-entity id (create-ihashtable components)))))
 
 (define (copy-entity entity)
   "Returns a copy of the provided entity. Returns false on error."
   (if (game-entity? entity)
       (make-game-entity (game-entity-id entity)
-                        (ihashtable (game-entity-components entity)))))
+                        (create-ihashtable (game-entity-components entity)))))
 
 (define (set-entity-components entity new-components)
   "Returns a copy of the provided entity with components set to new-components.
 Returns false on error."
+  (write-log! "Running entity:set-entity-components"
+              (when (game-entity? entity)
+                (game-entity-id entity))
+              (when (ihashtable? new-components)
+                (ihashtable-keys new-components)))
   (if (and (game-entity? entity)
            (ihashtable? new-components))
       (let ((id (game-entity-id entity))
             (current-components (game-entity-components entity)))
-        (create-entity id new-components))))
+        (create-entity id new-components))
+      (error "Invalid paramters passed to entity:set-entity-components" entity new-components)))
 
 (define (get-entity-components entity)
   "Returns the entity components in the form of an immutable hashtable.
 Returns false if entity is not a game-entity."
   (if (game-entity? entity)
       (game-entity-components entity)
-      #f))
+      (error "Invalid entity passed to get-entity-components" entity)))
 
 (define (create-entity-generator)
   "Returns a procedure which takes a list of components and creates
@@ -64,7 +72,8 @@ thread-safe."
             (atomic-box-swap! id-counter
                               (+ 1 (atomic-box-ref id-counter))))))
     (case-lambda
-      (() (create-entity (get-next-counter-value!)))
+      (()
+       (create-entity (get-next-counter-value!)))
       ((components)
        (create-entity (get-next-counter-value!)
                       components)))))
diff --git a/modules/ces/entity/entity-map.scm b/modules/ces/entity/entity-map.scm
index a8b51ff..1e7a04b 100644
--- a/modules/ces/entity/entity-map.scm
+++ b/modules/ces/entity/entity-map.scm
@@ -5,7 +5,9 @@
   #:use-module (hoot atomics)
   #:use-module (hoot hashtables)
   #:use-module (hoot match)
+  #:use-module (hoot debug)
   #:use-module (ces entity)
+  #:use-module (logging)
   #:export (entity-map?
             create-entity-map
             copy-entity-map
@@ -27,7 +29,8 @@
 
 (define create-entity-map
   (case-lambda
-    (() (make-entity-map (make-eq-hashtable)))
+    (()
+     (make-entity-map (make-eq-hashtable)))
     ((initial-entities)
      (cond
       ((list? initial-entities)
@@ -45,7 +48,7 @@
        (make-entity-map
         (hashtable-copy
          (entity-map-entities initial-entities))))
-      (else (create-entity-map))))))
+      (else (error "create-entity-map supplied with invalid input"))))))
 
 (define (entity-key entity)
   "Returns the entity id of an entity, or the value itself if it is
@@ -53,7 +56,7 @@ and integer already. Returns false if passed an invalid entity."
   (cond
    ((game-entity? entity)) (game-entity-id entity)
    ((integer? entity) entity)
-   (else #f)))
+   (else (error "Invalid entity-key parameter" entity))))
 
 (define (get-entity entity-map entity)
   "Returns the entity with the supplied entity-id if one exists.
@@ -82,11 +85,13 @@ an argument for criteria?"
 
 (define (set-entity! entity-map entity-id entity)
   "Replaces the entity in the entity-map the given entity."
-  (when (and (entity-map? entity-map)
-             (game-entity? entity))
-    (hashtable-set! (entity-map-entities entity-map)
-                    entity-id
-                    entity)))
+  (if (and (entity-map? entity-map)
+           (game-entity? entity))
+      (begin
+        (hashtable-set! (entity-map-entities entity-map)
+                        entity-id
+                        entity))
+      (error "Invalid game entity and entity-map" entity-map entity)))
 
 (define (delete-entity! entity-map entity)
   "Removes the entity from the entity map"
diff --git a/modules/game/game-manager.scm b/modules/game/game-manager.scm
index aa99102..89d01dd 100644
--- a/modules/game/game-manager.scm
+++ b/modules/game/game-manager.scm
@@ -14,21 +14,24 @@
   "Returns a list of initial game entities.  "
   (write-log! "Init game entities")
   (let*  ((room-background (get-image (get-media-library) 'room-background))
-          (ts-vec (write-log! (vector  
-                    (make-tile 'tile-blank 16 16)
-                    (make-tile 'tile-floor 16 16)
-                    (make-tile 'tile-wall 16 16)
-                    (make-tile 'tile-door 16 16))))
-          (tl-vec (write-log! 
+          (ts-vec
+           (write-log!
+            (vector
+             (make-tile 'tile-blank 16 16)
+             (make-tile 'tile-floor 16 16)
+             (make-tile 'tile-wall 16 16)
+             (make-tile 'tile-door 16 16))))
+          (tl-vec
+           (write-log!
             #(2 2 2 2 3 2 2 2
-              1 1 1 1 1 1 1 1
-              1 1 1 1 1 1 1 1
-              1 1 1 1 1 1 1 1)))
+                1 1 1 1 1 1 1 1
+                1 1 1 1 1 1 1 1
+                1 1 1 1 1 1 1 1)))
           (room-tilemap 
-            (make-tilemap 
-              (make-tileset ts-vec 16 16)
-              (list 
-                (make-tilemap-layer tl-vec 0 0 8 4)))))
+           (make-tilemap
+            (make-tileset ts-vec 16 16)
+            (list
+             (make-tilemap-layer tl-vec 0 0 8 4)))))
     (list (create-player!)
           (create-room! room-tilemap))))
 
diff --git a/modules/game/game-objects.scm b/modules/game/game-objects.scm
index 545e723..cb1a5d8 100644
--- a/modules/game/game-objects.scm
+++ b/modules/game/game-objects.scm
@@ -1,6 +1,7 @@
 (define-module (game game-objects)
   #:pure
   #:use-module (scheme base)
+  #:use-module (hoot debug)
   #:use-module (ces component)
   #:use-module (ces component hitbox)
   #:use-module (ces component position)
@@ -15,6 +16,7 @@
             create-game-object!))
 
 (define (add-position entity entity-id x y)
+  (write-log! "Running game-objects:add-position")
   (set-component entity 'position (create-position entity-id x y)))
 
 (define (add-hitbox entity entity-id x y w h)
@@ -24,18 +26,18 @@
   (set-component entity 'sprite (make-sprite entity-id sprite w h)))
 
 (define (add-game-object-components entity x y width height sprite)
+  (unless (game-entity? entity)
+    (error "Invalid entity passed to game-objects:add-game-object-components"))
   (let* ((entity-id (game-entity-id entity))
-         (entity (add-position entity entity-id x y))
-         (entity (add-hitbox entity entity-id x y width height))
-         (entity (add-sprite entity entity-id sprite width height)))
-    entity))
+         (p-entity (add-position entity entity-id x y))
+         (h-entity (add-hitbox p-entity entity-id x y width height))
+         (s-entity (add-sprite h-entity entity-id sprite width height)))
+    s-entity))
 
 (define (game-object? entity)
   (has-components? entity 'position 'hitbox 'sprite))
 
 (define (create-game-object! x y width height sprite)
-  (write-log! "create-game-object!")
-  (let* ((e-manager (write-log! (get-entity-manager)))
-         (entity (write-log! (create-entity! e-manager))))
-    (reset-entity! e-manager
-                   (add-game-object-components entity x y width height sprite))))
+  (let* ((e-manager (get-entity-manager))
+         (entity (create-entity! e-manager)))
+    (add-game-object-components entity x y width height sprite)))
diff --git a/modules/game/level-manager.scm b/modules/game/level-manager.scm
index 0616f52..15d314b 100644
--- a/modules/game/level-manager.scm
+++ b/modules/game/level-manager.scm
@@ -21,12 +21,9 @@
        (has-components? entity 'keyboard-input)))
 
 (define (create-player!)
-  (let* (
-         (player-sprite (write-log! (get-image (get-media-library) 'player)))
-         (initial-entity (write-log! (create-game-object! 0 0 16 16 player-sprite)))
-        )
-    (set-component initial-entity 'keyboard-input
-                   (create-inputs))))
+  (let* ((player-sprite (get-image (get-media-library) 'player))
+         (initial-entity (create-game-object! 0 0 16 16 'player-sprite)))
+    (set-component initial-entity 'keyboard-input (create-inputs))))
 
 ;; Room
 (define (room? entity)
@@ -45,10 +42,9 @@
   (add-tilemap entity tm))
 
 (define (create-room! tm)
-    (let* ((e-manager (get-entity-manager))
-           (entity (create-entity! e-manager)))
-        (reset-entity! e-manager 
-            (add-room-components entity tm))))
+  (let* ((e-manager (get-entity-manager))
+         (entity (create-entity! e-manager)))
+    (add-room-components entity tm)))
 
 ;; Floor
 ;; A floor is a list of rooms
diff --git a/modules/lib/ihashtable.scm b/modules/lib/ihashtable.scm
index 4414dd4..a5b90d7 100644
--- a/modules/lib/ihashtable.scm
+++ b/modules/lib/ihashtable.scm
@@ -4,8 +4,11 @@
   #:use-module (scheme case-lambda)
   #:use-module (hoot hashtables)
   #:use-module ((hoot syntax) #:select (define*))
+  #:use-module (logging)
   #:export (ihashtable?
-            ihashtable
+            create-ihashtable
+            ihashtable-keys
+            ihashtable-values
             ihashtable-contains?
             ihashtable-get
             ihashtable-assoc
@@ -34,18 +37,29 @@
                   lst))
       #f))
 
-(define ihashtable
+(define create-ihashtable
   (case-lambda
-    (() (make-ihashtable (make-eq-hashtable)))
+    (()
+     (make-ihashtable (make-eq-hashtable)))
     ((initial-values)
      (cond
       ((hashtable? initial-values)
-       (make-ihashtable (hashtable-copy values)))
+       (make-ihashtable (hashtable-copy initial-values)))
       ((ihashtable? initial-values)
        (%copy-ihashtable initial-values))
       ((list? initial-values)
        (make-ihashtable (%assoc-list->hashtable initial-values)))
-      (else (ihashtable))))))
+      (else (create-ihashtable))))))
+
+(define (ihashtable-keys ihashtable)
+  (if (ihashtable? ihashtable)
+      (hashtable-keys (ihashtable-entries ihashtable))
+      (error "Invalid ihashtable passed to ihashtable-keys" ihashtable)))
+
+(define (ihashtable-values ihashtable)
+  (if (ihashtable? ihashtable)
+      (hashtable-entries (ihashtable-entries ihashtable))
+      (error "Invalid ihashtable passed to ihashtable-values" ihashtable)))
 
 (define (ihashtable-contains? ihashtable key)
   "Returns true if the hashtable contains key"
@@ -57,7 +71,7 @@
 Returns false if there is an error."
   (if (ihashtable? ihashtable)
       (hashtable-ref (ihashtable-entries ihashtable) key default-value)
-      #f))
+      (error "Invalid ihashtable" ihashtable key default-value)))
 
 (define (ihashtable-assoc ihashtable key val)
   "Returns a copy of hashtable with key set to val.
@@ -67,8 +81,8 @@ Returns false if there is an error."
              (new-table (hashtable-copy backing-table)))
         (begin
           (hashtable-set! new-table key val)
-          (ihashtable new-table)))
-      #f))
+          (create-ihashtable new-table)))
+      (error "Invalid ihashtable" ihashtable key val)))
 
 (define (ihashtable-dissoc ihashtable key)
   "Returns a copy of hashtable without key.
@@ -78,8 +92,8 @@ Returns false on error."
              (new-table (hashtable-copy backing-table)))
         (begin
           (hashtable-delete! new-table key)
-          (ihashtable new-table)))
-      #f))
+          (create-ihashtable new-table)))
+      (error "Invalid ihashtable" ihashtable key)))
 
 (define (ihashtable-update ihashtable key proc)
   "Takes a two arity proc (key,value) and returns a new hashtable