Refresh docs and re-indent

1 files changed, 251 insertions, 246 deletions

diff --git a/renderer.scm b/renderer.scm
index b6ba238..50ae574 100644
--- a/renderer.scm
+++ b/renderer.scm
@@ -1,251 +1,256 @@
 (module downstroke-renderer
-    *
-  (import scheme
-          (chicken base)
-          (only srfi-1 iota for-each)
-          srfi-69
-          (prefix sdl2 "sdl2:")
-          (prefix sdl2-ttf "ttf:")
-          downstroke-entity
-          downstroke-tilemap
-          downstroke-world)
-
-  (import defstruct)
-
-  ;; --- Debug colors ---
-
-  (define +debug-player-color+ (sdl2:make-color  64 128 255))
-  (define +debug-enemy-color+  (sdl2:make-color 220  40  40))
-  (define +debug-attack-color+ (sdl2:make-color   0 200  80))
-  (define +debug-tile-color+   (sdl2:make-color 140   0 220))
-
-  ;; --- Sprite font data structure ---
-
-  (defstruct sprite-font
-    tile-size    ;; integer: pixel width/height of each glyph tile
-    spacing      ;; integer: pixels between characters
-    char-map)    ;; hash-table: char -> tile-id
-
-  ;; Public constructor for sprite-font
-  ;; ranges: list of (start-char end-char first-tile-id) triples
-  (define (make-sprite-font* #!key tile-size (spacing 1) ranges)
-    (let ((ht (make-hash-table)))
-      (for-each
-        (lambda (range)
-          (let ((start-char (car range))
-                (end-char (cadr range))
-                (first-tile-id (caddr range)))
-            (let loop ((ch start-char) (tile-id first-tile-id))
-              (when (char<=? ch end-char)
-                (let ((upcase-ch (char-upcase ch)))
-                  (when (hash-table-exists? ht upcase-ch)
-                    (error "sprite-font: overlapping range at char" upcase-ch))
-                  (hash-table-set! ht upcase-ch tile-id))
-                (loop (integer->char (+ (char->integer ch) 1)) (+ tile-id 1))))))
-        ranges)
-      (make-sprite-font tile-size: tile-size spacing: spacing char-map: ht)))
-
-  ;; Look up char tile-id (always upcase)
-  (define (sprite-font-char->tile-id font ch)
-    (hash-table-ref/default (sprite-font-char-map font) (char-upcase ch) #f))
-
-  ;; Compute pixel width of text
-  (define (sprite-text-width font text)
-    (let ((n (string-length text)))
-      (if (zero? n) 0
-          (+ (* n (sprite-font-tile-size font))
-             (* (- n 1) (sprite-font-spacing font))))))
-
-  ;; Draw sprite text using a bitmap font
-  (define (draw-sprite-text renderer tileset-texture tileset font text x y)
-    (let ((ts (sprite-font-tile-size font))
-          (sp (sprite-font-spacing font)))
-      (let loop ((i 0) (cx x))
-        (when (< i (string-length text))
-          (let ((tile-id (sprite-font-char->tile-id font (string-ref text i))))
-            (when tile-id
-              (sdl2:render-copy! renderer tileset-texture
-                (tile-rect (tileset-tile tileset tile-id))
-                (sdl2:make-rect cx y ts ts)))
-            (loop (+ i 1) (+ cx ts sp)))))))
-
-  ;; --- Pure functions (no SDL2, testable) ---
-
-  ;; Returns (x y w h) as a plain list — testable without SDL2
-  (define (entity-screen-coords entity camera)
-    (list (- (inexact->exact (floor (entity-ref entity #:x 0))) (camera-x camera))
-          (- (inexact->exact (floor (entity-ref entity #:y 0))) (camera-y camera))
-          (inexact->exact (floor (entity-ref entity #:width 0)))
-          (inexact->exact (floor (entity-ref entity #:height 0)))))
-
-  ;; Returns sdl2:rect for actual drawing
-  (define (entity->screen-rect entity camera)
-    (apply sdl2:make-rect (entity-screen-coords entity camera)))
-
-  ;; Returns flip list based on #:facing field
-  (define (entity-flip entity)
-    (if (= (entity-ref entity #:facing 1) -1) '(horizontal) '()))
-
-  ;; --- Tilemap drawing ---
-
-  (define (draw-tile renderer camera tileset tileset-texture tile-id row-num col-num)
-    (let ((tile (tileset-tile tileset tile-id)))
-      (sdl2:render-copy! renderer tileset-texture
-                         (tile-rect tile)
-                         (sdl2:make-rect
-                           (- (* col-num (tileset-tilewidth  tileset)) (camera-x camera))
-                           (- (* row-num (tileset-tileheight tileset)) (camera-y camera))
-                           (tileset-tilewidth  tileset)
-                           (tileset-tileheight tileset)))))
-
-  (define (draw-tilemap-rows draw-fn rows row-num)
-    (unless (null? rows)
-      (for-each
-        (cut draw-fn <> row-num <>)
-        (car rows)
-        (iota (length (car rows))))
-      (draw-tilemap-rows draw-fn (cdr rows) (+ row-num 1))))
-
-  (define (draw-tilemap renderer camera tileset-texture tilemap)
-    (let ((map-layers (tilemap-layers tilemap))
-          (tileset    (tilemap-tileset tilemap)))
-      (for-each
-        (lambda (layer)
-          (draw-tilemap-rows
-            (cut draw-tile renderer camera tileset tileset-texture <> <> <>)
-            (layer-map layer)
-            0))
-        map-layers)))
-
-  ;; --- Entity drawing ---
-
-  ;; #:color is (r g b) or (r g b a); used when no tile sprite is drawn.
-  (define (draw-entity renderer camera tileset tileset-texture entity)
-    (if (entity-ref entity #:skip-render #f)
-        (void)
-        (let ((tile-id (entity-ref entity #:tile-id #f))
-              (color   (entity-ref entity #:color #f)))
-          (cond
-        ((and tile-id tileset tileset-texture)
-         (sdl2:render-copy-ex! renderer tileset-texture
+*
+(import scheme
+        (chicken base)
+        (only srfi-1 iota for-each)
+        srfi-69
+        (prefix sdl2 "sdl2:")
+        (prefix sdl2-ttf "ttf:")
+        downstroke-entity
+        downstroke-tilemap
+        downstroke-world)
+
+(import defstruct)
+
+;; --- Debug colors ---
+
+(define +debug-player-color+ (sdl2:make-color  64 128 255))
+(define +debug-enemy-color+  (sdl2:make-color 220  40  40))
+(define +debug-attack-color+ (sdl2:make-color   0 200  80))
+(define +debug-tile-color+   (sdl2:make-color 140   0 220))
+
+;; --- Sprite font data structure ---
+
+(defstruct sprite-font
+  tile-size    ;; integer: pixel width/height of each glyph tile
+  spacing      ;; integer: pixels between characters
+  char-map)    ;; hash-table: char -> tile-id
+
+;; Public constructor for sprite-font
+;; ranges: list of (start-char end-char first-tile-id) triples
+(define (make-sprite-font* #!key tile-size (spacing 1) ranges)
+  (let ((ht (make-hash-table)))
+    (for-each
+     (lambda (range)
+       (let ((start-char (car range))
+             (end-char (cadr range))
+             (first-tile-id (caddr range)))
+         (let loop ((ch start-char) (tile-id first-tile-id))
+           (when (char<=? ch end-char)
+             (let ((upcase-ch (char-upcase ch)))
+               (when (hash-table-exists? ht upcase-ch)
+                 (error "sprite-font: overlapping range at char" upcase-ch))
+               (hash-table-set! ht upcase-ch tile-id))
+             (loop (integer->char (+ (char->integer ch) 1)) (+ tile-id 1))))))
+     ranges)
+    (make-sprite-font tile-size: tile-size spacing: spacing char-map: ht)))
+
+;; Look up char tile-id (always upcase)
+(define (sprite-font-char->tile-id font ch)
+  (hash-table-ref/default (sprite-font-char-map font) (char-upcase ch) #f))
+
+;; Compute pixel width of text
+(define (sprite-text-width font text)
+  (let ((n (string-length text)))
+    (if (zero? n) 0
+        (+ (* n (sprite-font-tile-size font))
+           (* (- n 1) (sprite-font-spacing font))))))
+
+;; Draw sprite text using a bitmap font
+(define (draw-sprite-text renderer tileset-texture tileset font text x y)
+  (let ((ts (sprite-font-tile-size font))
+        (sp (sprite-font-spacing font)))
+    (let loop ((i 0) (cx x))
+      (when (< i (string-length text))
+        (let ((tile-id (sprite-font-char->tile-id font (string-ref text i))))
+          (when tile-id
+            (sdl2:render-copy! renderer tileset-texture
                                (tile-rect (tileset-tile tileset tile-id))
-                               (entity->screen-rect entity camera)
-                               0.0
-                               #f
-                               (entity-flip entity)))
-            ((and (list? color) (>= (length color) 3))
-             (let ((r (list-ref color 0))
-                   (g (list-ref color 1))
-                   (b (list-ref color 2))
-                   (a (if (>= (length color) 4) (list-ref color 3) 255)))
-               (set! (sdl2:render-draw-color renderer) (sdl2:make-color r g b a))
-               (sdl2:render-fill-rect! renderer (entity->screen-rect entity camera))))
-            (else #f)))))
-
-  (define (draw-entities renderer camera tileset tileset-texture entities)
+                               (sdl2:make-rect cx y ts ts)))
+          (loop (+ i 1) (+ cx ts sp)))))))
+
+;; --- Pure functions (no SDL2, testable) ---
+
+;; Returns (x y w h) as a plain list — testable without SDL2
+(define (entity-screen-coords entity camera)
+  (list (- (inexact->exact (floor (entity-ref entity #:x 0))) (camera-x camera))
+        (- (inexact->exact (floor (entity-ref entity #:y 0))) (camera-y camera))
+        (inexact->exact (floor (entity-ref entity #:width 0)))
+        (inexact->exact (floor (entity-ref entity #:height 0)))))
+
+;; Returns sdl2:rect for actual drawing
+(define (entity->screen-rect entity camera)
+  (apply sdl2:make-rect (entity-screen-coords entity camera)))
+
+;; Returns flip list based on #:facing field
+(define (entity-flip entity)
+  (if (= (entity-ref entity #:facing 1) -1) '(horizontal) '()))
+
+;; --- Tilemap drawing ---
+
+(define (draw-tile renderer camera tileset tileset-texture tile-id row-num col-num)
+  (let ((tile (tileset-tile tileset tile-id)))
+    (sdl2:render-copy! renderer tileset-texture
+                       (tile-rect tile)
+                       (sdl2:make-rect
+                        (- (* col-num (tileset-tilewidth  tileset)) (camera-x camera))
+                        (- (* row-num (tileset-tileheight tileset)) (camera-y camera))
+                        (tileset-tilewidth  tileset)
+                        (tileset-tileheight tileset)))))
+
+(define (draw-tilemap-rows draw-fn rows row-num)
+  (unless (null? rows)
+    (for-each
+     (cut draw-fn <> row-num <>)
+     (car rows)
+     (iota (length (car rows))))
+    (draw-tilemap-rows draw-fn (cdr rows) (+ row-num 1))))
+
+(define (draw-tilemap renderer camera tileset-texture tilemap)
+  (let ((map-layers (tilemap-layers tilemap))
+        (tileset    (tilemap-tileset tilemap)))
+    (for-each
+     (lambda (layer)
+       (draw-tilemap-rows
+        (cut draw-tile renderer camera tileset tileset-texture <> <> <>)
+        (layer-map layer)
+        0))
+     map-layers)))
+
+;; --- Entity drawing ---
+
+;; #:color is (r g b) or (r g b a); used when no tile sprite is drawn.
+(define (draw-entity renderer camera tileset tileset-texture entity)
+  (if (entity-ref entity #:skip-render #f)
+      (void)
+      (let ((tile-id (entity-ref entity #:tile-id #f))
+            (color   (entity-ref entity #:color #f)))
+        (cond
+         ((and tile-id tileset tileset-texture)
+          (sdl2:render-copy-ex! renderer tileset-texture
+                                (tile-rect (tileset-tile tileset tile-id))
+                                (entity->screen-rect entity camera)
+                                0.0
+                                #f
+                                (entity-flip entity)))
+         ((and (list? color) (>= (length color) 3))
+          (let ((r (list-ref color 0))
+                (g (list-ref color 1))
+                (b (list-ref color 2))
+                (a (if (>= (length color) 4) (list-ref color 3) 255)))
+            (set! (sdl2:render-draw-color renderer) (sdl2:make-color r g b a))
+            (sdl2:render-fill-rect! renderer (entity->screen-rect entity camera))))
+         (else #f)))))
+
+(define (draw-entities renderer camera tileset tileset-texture entities)
+  (for-each
+   (lambda (e) (draw-entity renderer camera tileset tileset-texture e))
+   entities))
+
+;; --- Text drawing ---
+
+(define (draw-ui-text renderer font text color x y)
+  (let* ((surface (ttf:render-text-solid font text color))
+         (texture (sdl2:create-texture-from-surface renderer surface))
+         (dims    (call-with-values (lambda () (ttf:size-utf8 font text)) cons))
+         (w (car dims))
+         (h (cdr dims)))
+    (sdl2:render-copy! renderer texture #f
+                       (sdl2:make-rect x y w h))))
+
+;; --- Menu drawing ---
+
+(define (draw-menu-items renderer font items cursor x y-start y-step
+                         #!key (label-fn identity) (color #f) (prefix "> ") (no-prefix "  "))
+  (let loop ((i 0) (rest items))
+    (unless (null? rest)
+      (draw-ui-text renderer font
+                    (string-append (if (= i cursor) prefix no-prefix)
+                                   (label-fn (car rest)))
+                    (or color (sdl2:make-color 255 255 255))
+                    x (+ y-start (* i y-step)))
+      (loop (+ i 1) (cdr rest)))))
+
+;; --- Scene drawing ---
+
+(define (render-scene! renderer scene)
+  (let* ((camera          (scene-camera scene))
+         (tilemap         (scene-tilemap scene))
+         (scene-ts        (scene-tileset scene))
+         (tileset-texture (scene-tileset-texture scene))
+         (entities        (scene-entities scene))
+         ;; Resolve the tileset for rect math independently of the
+         ;; texture. draw-entity itself guards on the texture, so sprite
+         ;; entities still fall back to #:color rendering when no texture
+         ;; is available (instead of being silently dropped).
+         (tileset (or scene-ts (and tilemap (tilemap-tileset tilemap)))))
+    (when (and tilemap tileset-texture)
+      (draw-tilemap renderer camera tileset-texture tilemap))
+    (draw-entities renderer camera tileset tileset-texture entities)))
+
+;; --- Debug drawing ---
+
+(define (draw-debug-tiles renderer camera tilemap)
+  (let ((tw (tilemap-tilewidth  tilemap))
+        (th (tilemap-tileheight tilemap))
+        (cx (camera-x camera))
+        (cy (camera-y camera)))
+    (set! (sdl2:render-draw-color renderer) +debug-tile-color+)
+    (for-each
+     (lambda (layer)
+       (let row-loop ((rows (layer-map layer)) (row 0))
+         (unless (null? rows)
+           (let col-loop ((tiles (car rows)) (col 0))
+             (unless (null? tiles)
+               (unless (zero? (car tiles))
+                 (sdl2:render-fill-rect! renderer
+                                         (sdl2:make-rect (- (* col tw) cx)
+                                                         (- (* row th) cy)
+                                                         tw th)))
+               (col-loop (cdr tiles) (+ col 1))))
+           (row-loop (cdr rows) (+ row 1)))))
+     (tilemap-layers tilemap))))
+
+(define (draw-attack-hitbox renderer e tw cx cy)
+  (when (> (entity-ref e #:attack-timer 0) 0)
+    (let* ((ex     (inexact->exact (floor (entity-ref e #:x 0))))
+           (ey     (inexact->exact (floor (entity-ref e #:y 0))))
+           (ew     (inexact->exact (floor (entity-ref e #:width 0))))
+           (eh     (inexact->exact (floor (entity-ref e #:height 0))))
+           (facing (entity-ref e #:facing 1))
+           (ax     (if (> facing 0) (+ ex ew) (- ex tw))))
+      (set! (sdl2:render-draw-color renderer) +debug-attack-color+)
+      (sdl2:render-fill-rect! renderer
+                              (sdl2:make-rect (- ax cx) (- ey cy) tw eh)))))
+
+(define (draw-debug-entities renderer camera scene)
+  (let* ((tilemap (scene-tilemap scene))
+         ;; Hitbox thickness falls back to the entity's own width when
+         ;; no tilemap is present (sprite-only scenes).
+         (tw      (and tilemap (tilemap-tilewidth tilemap)))
+         (cx      (camera-x camera))
+         (cy      (camera-y camera)))
     (for-each
-      (lambda (e) (draw-entity renderer camera tileset tileset-texture e))
-      entities))
-
-  ;; --- Text drawing ---
-
-  (define (draw-ui-text renderer font text color x y)
-    (let* ((surface (ttf:render-text-solid font text color))
-           (texture (sdl2:create-texture-from-surface renderer surface))
-           (dims    (call-with-values (lambda () (ttf:size-utf8 font text)) cons))
-           (w (car dims))
-           (h (cdr dims)))
-      (sdl2:render-copy! renderer texture #f
-                         (sdl2:make-rect x y w h))))
-
-  ;; --- Menu drawing ---
-
-  (define (draw-menu-items renderer font items cursor x y-start y-step
-                           #!key (label-fn identity) (color #f) (prefix "> ") (no-prefix "  "))
-    (let loop ((i 0) (rest items))
-      (unless (null? rest)
-        (draw-ui-text renderer font
-                      (string-append (if (= i cursor) prefix no-prefix)
-                                     (label-fn (car rest)))
-                      (or color (sdl2:make-color 255 255 255))
-                      x (+ y-start (* i y-step)))
-        (loop (+ i 1) (cdr rest)))))
-
-  ;; --- Scene drawing ---
-
-  (define (render-scene! renderer scene)
-    (let* ((camera          (scene-camera scene))
-           (tilemap         (scene-tilemap scene))
-           (scene-ts        (scene-tileset scene))
-           (tileset-texture (scene-tileset-texture scene))
-           (entities        (scene-entities scene))
-           (tileset
-             (and tileset-texture
-                  (or scene-ts (and tilemap (tilemap-tileset tilemap))))))
-      (when tilemap
-        (draw-tilemap renderer camera tileset-texture tilemap))
-      (draw-entities renderer camera tileset tileset-texture entities)))
-
-  ;; --- Debug drawing ---
-
-  (define (draw-debug-tiles renderer camera tilemap)
-    (let ((tw (tilemap-tilewidth  tilemap))
-          (th (tilemap-tileheight tilemap))
-          (cx (camera-x camera))
-          (cy (camera-y camera)))
-      (set! (sdl2:render-draw-color renderer) +debug-tile-color+)
-      (for-each
-        (lambda (layer)
-          (let row-loop ((rows (layer-map layer)) (row 0))
-            (unless (null? rows)
-              (let col-loop ((tiles (car rows)) (col 0))
-                (unless (null? tiles)
-                  (unless (zero? (car tiles))
-                    (sdl2:render-fill-rect! renderer
-                      (sdl2:make-rect (- (* col tw) cx)
-                                     (- (* row th) cy)
-                                     tw th)))
-                  (col-loop (cdr tiles) (+ col 1))))
-              (row-loop (cdr rows) (+ row 1)))))
-        (tilemap-layers tilemap))))
-
-  (define (draw-attack-hitbox renderer e tw cx cy)
-    (when (> (entity-ref e #:attack-timer 0) 0)
-      (let* ((ex     (inexact->exact (floor (entity-ref e #:x 0))))
-             (ey     (inexact->exact (floor (entity-ref e #:y 0))))
-             (ew     (inexact->exact (floor (entity-ref e #:width 0))))
-             (eh     (inexact->exact (floor (entity-ref e #:height 0))))
-             (facing (entity-ref e #:facing 1))
-             (ax     (if (> facing 0) (+ ex ew) (- ex tw))))
-        (set! (sdl2:render-draw-color renderer) +debug-attack-color+)
-        (sdl2:render-fill-rect! renderer
-          (sdl2:make-rect (- ax cx) (- ey cy) tw eh)))))
-
-  (define (draw-debug-entities renderer camera scene)
-    (let* ((tilemap (scene-tilemap scene))
-           (tw      (tilemap-tilewidth tilemap))
-           (cx      (camera-x camera))
-           (cy      (camera-y camera)))
-      (for-each
-        (lambda (e)
-          (let ((type (entity-type e))
-                (rect (entity->screen-rect e camera)))
-            (cond
-              ((eq? type 'player)
-               (set! (sdl2:render-draw-color renderer) +debug-player-color+)
-               (sdl2:render-fill-rect! renderer rect)
-               (draw-attack-hitbox renderer e tw cx cy))
-              ((eq? type 'enemy)
-               (set! (sdl2:render-draw-color renderer) +debug-enemy-color+)
-               (sdl2:render-fill-rect! renderer rect)
-               (draw-attack-hitbox renderer e tw cx cy)))))
-        (scene-entities scene))))
-
-  (define (render-debug-scene! renderer scene)
-    (let ((camera  (scene-camera scene))
-          (tilemap (scene-tilemap scene)))
-      (when tilemap
-        (draw-debug-tiles renderer camera tilemap))
-      (draw-debug-entities renderer camera scene)))
+     (lambda (e)
+       (let ((type (entity-type e))
+             (rect (entity->screen-rect e camera))
+             (hit-w (or tw (entity-ref e #:width 0))))
+         (cond
+          ((eq? type 'player)
+           (set! (sdl2:render-draw-color renderer) +debug-player-color+)
+           (sdl2:render-fill-rect! renderer rect)
+           (draw-attack-hitbox renderer e hit-w cx cy))
+          ((eq? type 'enemy)
+           (set! (sdl2:render-draw-color renderer) +debug-enemy-color+)
+           (sdl2:render-fill-rect! renderer rect)
+           (draw-attack-hitbox renderer e hit-w cx cy)))))
+     (scene-entities scene))))
+
+(define (render-debug-scene! renderer scene)
+  (let ((camera  (scene-camera scene))
+        (tilemap (scene-tilemap scene)))
+    (when tilemap
+      (draw-debug-tiles renderer camera tilemap))
+    (draw-debug-entities renderer camera scene)))
 
 ) ;; end module renderer