Fixes, updated license

3 files changed, 182 insertions, 3 deletions

diff --git a/tests/engine-test.scm b/tests/engine-test.scm
index 79b475e..85481ac 100644
--- a/tests/engine-test.scm
+++ b/tests/engine-test.scm
@@ -104,7 +104,8 @@
 ;; --- Renderer module (mock) ---
 (module downstroke-renderer *
   (import scheme (chicken base))
-  (define (render-scene! . args) #f))
+  (define (render-scene! . args) #f)
+  (define (render-debug-scene! . args) #f))
 (import downstroke-renderer)
 
 ;; --- Engine module (real) ---
@@ -141,7 +142,10 @@
     (test-assert "assets registry is created"
       (game-assets g))
     (test-assert "input state is created"
-      (game-input g))))
+      (game-input g))
+    (test-equal "debug? defaults to #f"
+      #f
+      (game-debug? g))))
 
 (test-group "make-game with keyword args"
   (let ((g (make-game title: "My Game" width: 320 height: 240 frame-delay: 33)))
@@ -150,6 +154,14 @@
     (test-equal "custom height" 240 (game-height g))
     (test-equal "custom frame-delay" 33 (game-frame-delay g))))
 
+(test-group "make-game debug? keyword"
+  (test-equal "debug? defaults to #f"
+    #f
+    (game-debug? (make-game)))
+  (test-equal "debug? can be set to #t"
+    #t
+    (game-debug? (make-game debug?: #t))))
+
 (test-group "game-asset and game-asset-set!"
   (let ((g (make-game)))
     (test-equal "missing key returns #f"
diff --git a/tests/physics-test.scm b/tests/physics-test.scm
index 858dec8..67c8377 100644
--- a/tests/physics-test.scm
+++ b/tests/physics-test.scm
@@ -294,6 +294,17 @@
         (test-equal "pushed above floor" 28 (entity-ref result #:y))
         (test-equal "vy zeroed" 0 (entity-ref result #:vy))))))
 
+  (test-group "high-velocity fall: snaps to first solid row, not last"
+    ;; Regression: entity falls fast enough that apply-velocity-y moves it into TWO solid rows.
+    ;; Rows 2 and 3 are both solid (tileheight=16, so row 2 = y=[32,47], row 3 = y=[48,63]).
+    ;; After apply-velocity-y the entity lands at y=34 (overlapping both rows 2 and 3).
+    ;; Correct: snap to top of row 2 → y=16. Bug was: fold overwrote row 2 snap with row 3 snap → y=32 (inside row 2).
+    (let* ((tm (make-test-tilemap '((0 0 0) (0 0 0) (1 0 0) (1 0 0) (0 0 0))))
+           (e  '(#:type player #:x 0 #:y 34 #:width 16 #:height 16 #:vx 0 #:vy 20)))
+      (let ((result (resolve-tile-collisions-y e tm)))
+        (test-equal "snapped to first solid row" 16 (entity-ref result #:y))
+        (test-equal "vy zeroed" 0 (entity-ref result #:vy)))))
+
 ;; Integration test: simulate the actual game physics loop
 (test-group "multi-frame physics simulation"
   (test-group "player falls and lands on floor (10 frames)"
diff --git a/tests/renderer-test.scm b/tests/renderer-test.scm
index fc5c8f2..1a8f7df 100644
--- a/tests/renderer-test.scm
+++ b/tests/renderer-test.scm
@@ -3,6 +3,7 @@
         (chicken base)
         (chicken keyword)
         (only srfi-1 fold iota for-each)
+        srfi-69
         defstruct
         srfi-64)
 
@@ -21,9 +22,13 @@
 (module sdl2 *
   (import scheme (chicken base))
   (define (make-rect x y w h) (list x y w h))
+  (define (make-color r g b) (list r g b))
   (define (render-copy! . args) #f)
   (define (render-copy-ex! . args) #f)
-  (define (create-texture-from-surface . args) #f))
+  (define (create-texture-from-surface . args) #f)
+  (define (render-fill-rect! . args) #f)
+  ;; Mock SRFI-17 setter for render-draw-color
+  (define render-draw-color (getter-with-setter (lambda (r) #f) (lambda (r c) #f))))
 (import (prefix sdl2 "sdl2:"))
 
 ;; Mock sdl2-ttf
@@ -110,4 +115,155 @@
     (test-assert "does not crash on valid scene"
       (begin (render-scene! #f scene) #t))))
 
+(test-group "sprite-font"
+  (test-group "make-sprite-font*"
+    (let ((font (make-sprite-font* tile-size: 8 spacing: 1
+                                    ranges: (list (list #\A #\C 100)))))
+      (test-equal "A maps to 100"
+                  100
+                  (sprite-font-char->tile-id font #\A))
+      (test-equal "B maps to 101"
+                  101
+                  (sprite-font-char->tile-id font #\B))
+      (test-equal "C maps to 102"
+                  102
+                  (sprite-font-char->tile-id font #\C))))
+
+  (test-group "sprite-font-char->tile-id"
+    (let ((font (make-sprite-font* tile-size: 8 spacing: 1
+                                    ranges: (list (list #\A #\Z 100)))))
+      (test-equal "returns #f for unmapped char"
+                  #f
+                  (sprite-font-char->tile-id font #\1))
+      (test-equal "auto-upcase: lowercase a maps to uppercase"
+                  100
+                  (sprite-font-char->tile-id font #\a))))
+
+  (test-group "overlapping ranges"
+    (import (chicken condition))
+    (let ((caught-error #f))
+      (condition-case
+        (make-sprite-font* tile-size: 8 spacing: 1
+                           ranges: (list (list #\A #\C 100)
+                                         (list #\B #\D 200)))
+        (e (exn)
+           (set! caught-error #t)))
+      (test-assert "signals error on overlapping range"
+        caught-error)))
+
+  (test-group "sprite-text-width"
+    (let ((font (make-sprite-font* tile-size: 8 spacing: 1
+                                    ranges: (list (list #\A #\Z 100)))))
+      (test-equal "empty string width is 0"
+                  0
+                  (sprite-text-width font ""))
+      (test-equal "single char width is tile-size"
+                  8
+                  (sprite-text-width font "A"))
+      (test-equal "two chars: 2*tile-size + 1*spacing"
+                  17
+                  (sprite-text-width font "AB"))
+      (test-equal "three chars: 3*tile-size + 2*spacing"
+                  26
+                  (sprite-text-width font "ABC"))))
+
+  (test-group "draw-sprite-text"
+    (let* ((font    (make-sprite-font* tile-size: 8 spacing: 1
+                                       ranges: (list (list #\A #\Z 100))))
+           (tileset (make-tileset tilewidth: 8 tileheight: 8
+                                  spacing: 0 tilecount: 100 columns: 10
+                                  image-source: "" image: #f))
+           (renderer #f)
+           (texture  #f))
+      (test-assert "does not crash with valid text"
+        (begin (draw-sprite-text renderer texture tileset font "HELLO" 10 20) #t))
+      (test-assert "does not crash with unmapped chars"
+        (begin (draw-sprite-text renderer texture tileset font "A1B" 0 0) #t)))))
+
+(test-group "draw-menu-items"
+  (test-assert "does not crash with 3 items, cursor=1"
+    (let ((font #f))  ; mock font
+      (begin
+        (draw-menu-items #f font '("Item 1" "Item 2" "Item 3") 1 10 20 30)
+        #t)))
+
+  (test-assert "does not crash with keyword args label-fn:"
+    (let ((font #f))
+      (begin
+        (draw-menu-items #f font '("A" "B" "C") 0 10 20 30
+                         label-fn: (lambda (x) (string-append "[" x "]")))
+        #t)))
+
+  (test-assert "does not crash with keyword args prefix:"
+    (let ((font #f))
+      (begin
+        (draw-menu-items #f font '("Item 1" "Item 2") 1 10 20 30
+                         prefix: ">>> " no-prefix: "    ")
+        #t))))
+
+(test-group "debug-drawing"
+  (test-group "draw-debug-tiles"
+    (let* ((cam      (make-camera x: 0 y: 0))
+           (tileset  (make-tileset tilewidth: 16 tileheight: 16
+                                   spacing: 0 tilecount: 100 columns: 10
+                                   image-source: "" image: #f))
+           (layer    (make-layer name: "ground" width: 2 height: 2
+                                 map: '((0 1) (2 3))))
+           (tilemap  (make-tilemap width: 2 height: 2
+                                   tilewidth: 16 tileheight: 16
+                                   tileset-source: ""
+                                   tileset: tileset
+                                   layers: (list layer)
+                                   objects: '()))
+           (renderer #f))
+      (test-assert "does not crash with 2x2 tilemap"
+        (begin (draw-debug-tiles renderer cam tilemap) #t))))
+
+  (test-group "draw-debug-entities"
+    (let* ((cam      (make-camera x: 0 y: 0))
+           (tileset  (make-tileset tilewidth: 16 tileheight: 16
+                                   spacing: 0 tilecount: 100 columns: 10
+                                   image-source: "" image: #f))
+           (layer    (make-layer name: "ground" width: 1 height: 1
+                                 map: '((0))))
+           (tilemap  (make-tilemap width: 1 height: 1
+                                   tilewidth: 16 tileheight: 16
+                                   tileset-source: ""
+                                   tileset: tileset
+                                   layers: (list layer)
+                                   objects: '()))
+           (player   (list #:type 'player #:x 10 #:y 20 #:width 16 #:height 16 #:facing 1))
+           (enemy    (list #:type 'enemy #:x 50 #:y 60 #:width 16 #:height 16 #:facing -1))
+           (scene    (make-scene entities: (list player enemy)
+                                 tilemap: tilemap
+                                 camera: cam
+                                 tileset-texture: #f
+                                 camera-target: #f))
+           (renderer #f))
+      (test-assert "does not crash with player and enemy entities"
+        (begin (draw-debug-entities renderer cam scene) #t))))
+
+  (test-group "render-debug-scene!"
+    (let* ((cam      (make-camera x: 0 y: 0))
+           (tileset  (make-tileset tilewidth: 16 tileheight: 16
+                                   spacing: 0 tilecount: 100 columns: 10
+                                   image-source: "" image: #f))
+           (layer    (make-layer name: "ground" width: 1 height: 1
+                                 map: '((0))))
+           (tilemap  (make-tilemap width: 1 height: 1
+                                   tilewidth: 16 tileheight: 16
+                                   tileset-source: ""
+                                   tileset: tileset
+                                   layers: (list layer)
+                                   objects: '()))
+           (player   (list #:type 'player #:x 10 #:y 20 #:width 16 #:height 16 #:facing 1))
+           (scene    (make-scene entities: (list player)
+                                 tilemap: tilemap
+                                 camera: cam
+                                 tileset-texture: #f
+                                 camera-target: #f))
+           (renderer #f))
+      (test-assert "does not crash with full scene"
+        (begin (render-debug-scene! renderer scene) #t)))))
+
 (test-end "renderer")