Complete implementation

1 files changed, 148 insertions, 0 deletions

diff --git a/tests/scene-loader-test.scm b/tests/scene-loader-test.scm
new file mode 100644
index 0000000..61f142f
--- /dev/null
+++ b/tests/scene-loader-test.scm
@@ -0,0 +1,148 @@
+;; Load base deps
+(import scheme
+        (chicken base)
+        (chicken keyword)
+        (only srfi-1 fold filter)
+        defstruct
+        srfi-64)
+
+;; Mock tilemap module
+(module downstroke/tilemap *
+  (import scheme (chicken base) defstruct)
+  (defstruct tileset tilewidth tileheight spacing tilecount columns image-source image)
+  (defstruct layer name width height map)
+  (defstruct object name type x y width height properties)
+  (defstruct tilemap width height tilewidth tileheight tileset-source tileset layers objects)
+  (defstruct tile id rect)
+  (define (tileset-tile ts id) (make-tile id: id rect: #f))
+  (define (tile-rect t) #f)
+  (define (load-tilemap filename) (make-tilemap width: 100 height: 100 tilewidth: 16 tileheight: 16 tileset-source: "" tileset: (make-tileset tilewidth: 16 tileheight: 16 spacing: 0 tilecount: 256 columns: 16 image-source: "" image: #f) layers: '() objects: '()))
+  (define (load-tileset filename) (make-tileset tilewidth: 16 tileheight: 16 spacing: 0 tilecount: 256 columns: 16 image-source: "" image: #f)))
+(import downstroke/tilemap)
+
+;; Mock entity module (minimal)
+(module downstroke/entity *
+  (import scheme (chicken base))
+  (define (entity-ref entity key #!optional (default #f))
+    (let loop ((plist entity))
+      (cond
+        ((null? plist) (if (procedure? default) (default) default))
+        ((eq? (car plist) key) (cadr plist))
+        (else (loop (cddr plist))))))
+  (define (entity-set entity key val)
+    (let loop ((plist entity) (acc '()))
+      (cond
+        ((null? plist) (reverse (cons val (cons key acc))))
+        ((eq? (car plist) key) (append (reverse acc) (cons key (cons val (cddr plist)))))
+        (else (loop (cddr plist) (cons (cadr plist) (cons (car plist) acc)))))))
+  (define (entity-type entity)
+    (entity-ref entity #:type #f)))
+(import downstroke/entity)
+
+;; Mock world module
+(module downstroke/world *
+  (import scheme (chicken base) defstruct)
+  (defstruct camera x y)
+  (defstruct scene entities tilemap camera tileset-texture camera-target)
+  (define (scene-add-entity scene entity)
+    (scene-entities-set! scene (cons entity (scene-entities scene)))
+    scene))
+(import downstroke/world)
+
+;; Mock assets module
+(module downstroke/assets *
+  (import scheme (chicken base))
+  (define (asset-set! assets key value) #f))
+(import downstroke/assets)
+
+;; Mock engine module
+(module downstroke/engine *
+  (import scheme (chicken base))
+  (define (game-renderer game) #f)
+  (define (game-asset-set! game key value) #f)
+  (define (game-scene-set! game scene) #f))
+(import downstroke/engine)
+
+;; Mock sdl2
+(module sdl2 *
+  (import scheme (chicken base))
+  (define (create-texture-from-surface renderer surface) #f))
+(import (prefix sdl2 "sdl2:"))
+
+;; Mock sdl2-ttf
+(module sdl2-ttf *
+  (import scheme (chicken base))
+  (define (open-font filename size) (list 'font filename size)))
+(import (prefix sdl2-ttf "ttf:"))
+
+;; Load scene-loader module
+(include "scene-loader.scm")
+(import downstroke/scene-loader)
+
+(test-begin "scene-loader")
+
+(test-group "make-prefab-registry + instantiate-prefab"
+  (let* ((registry (make-prefab-registry
+                     'player (lambda (x y w h) (list #:type 'player #:x x #:y y #:width w #:height h))
+                     'enemy  (lambda (x y w h) (list #:type 'enemy  #:x x #:y y #:width w #:height h))))
+         (result (instantiate-prefab registry 'player 10 20 16 16)))
+    (test-assert "instantiate-prefab returns a plist for known type"
+      (list? result))
+    (test-equal "player has correct x"
+      10
+      (entity-ref result #:x))
+    (test-equal "player has correct type"
+      'player
+      (entity-ref result #:type))
+    (test-assert "unknown type returns #f"
+      (not (instantiate-prefab registry 'unknown 10 20 16 16)))))
+
+(test-group "tilemap-objects->entities"
+  (let* ((obj1 (make-object name: "player1" type: "player"     x: 10  y: 20  width: 16 height: 16 properties: '()))
+         (obj2 (make-object name: "deco"    type: "decoration" x: 50  y: 60  width: 32 height: 32 properties: '()))
+         (obj3 (make-object name: "enemy1"  type: "enemy"      x: 100 y: 120 width: 16 height: 16 properties: '()))
+         (tm   (make-tilemap width: 100 height: 100 tilewidth: 16 tileheight: 16
+                             tileset-source: "" tileset: #f layers: '()
+                             objects: (list obj1 obj2 obj3)))
+         (fn   (lambda (type x y w h)
+                 (cond
+                   ((eq? type 'player) (list #:type 'player #:x x #:y y #:width w #:height h))
+                   ((eq? type 'enemy)  (list #:type 'enemy  #:x x #:y y #:width w #:height h))
+                   (else #f))))
+         (result (tilemap-objects->entities tm fn)))
+    (test-equal "filters #f results: 2 entities from 3 objects"
+      2
+      (length result))
+    (test-equal "first entity is player"
+      'player
+      (entity-ref (car result) #:type))
+    (test-equal "second entity is enemy"
+      'enemy
+      (entity-ref (cadr result) #:type)))
+
+  (let* ((tm-empty (make-tilemap width: 100 height: 100 tilewidth: 16 tileheight: 16
+                                 tileset-source: "" tileset: #f layers: '()
+                                 objects: '()))
+         (result (tilemap-objects->entities tm-empty (lambda (t x y w h) #f))))
+    (test-equal "empty object list returns empty list"
+      0
+      (length result))))
+
+(test-group "game-load-tilemap! / game-load-tileset! / game-load-font!"
+  ;; game-load-tilemap! calls load-tilemap and stores result
+  ;; We can't test file I/O directly, but we can verify the function exists
+  ;; and that our mock game-asset-set! doesn't crash
+  (test-assert "game-load-tilemap! is a procedure"
+    (procedure? game-load-tilemap!))
+  (test-assert "game-load-tileset! is a procedure"
+    (procedure? game-load-tileset!))
+  (test-assert "game-load-font! is a procedure"
+    (procedure? game-load-font!))
+  ;; game-load-font! with mock ttf returns a font value
+  (let* ((game #f)  ; mock game (game-asset-set! ignores it in mock)
+         (font (ttf:open-font "test.ttf" 16)))
+    (test-equal "mock font is a list"
+      'font
+      (car font))))
+
+(test-end "scene-loader")