Fixes, updated license

1 files changed, 140 insertions, 0 deletions

diff --git a/renderer.scm b/renderer.scm
index 28c7079..e7daf11 100644
--- a/renderer.scm
+++ b/renderer.scm
@@ -3,12 +3,72 @@
   (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
@@ -85,6 +145,19 @@
       (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)
@@ -98,4 +171,71 @@
           (let ((tileset (tilemap-tileset 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-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)
+               (when (> (entity-ref e #:attack-timer 0) 0)
+                 (let* ((px     (inexact->exact (floor (entity-ref e #:x 0))))
+                        (py     (inexact->exact (floor (entity-ref e #:y 0))))
+                        (pw     (inexact->exact (floor (entity-ref e #:width 0))))
+                        (ph     (inexact->exact (floor (entity-ref e #:height 0))))
+                        (facing (entity-ref e #:facing 1))
+                        (ax     (if (> facing 0) (+ px pw) (- px tw))))
+                   (set! (sdl2:render-draw-color renderer) +debug-attack-color+)
+                   (sdl2:render-fill-rect! renderer
+                     (sdl2:make-rect (- ax cx) (- py cy) tw ph)))))
+              ((eq? type 'enemy)
+               (set! (sdl2:render-draw-color renderer) +debug-enemy-color+)
+               (sdl2:render-fill-rect! renderer rect)
+               (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))))
+                        (eh     (inexact->exact (floor (entity-ref e #:height 0))))
+                        (facing (entity-ref e #:facing 1))
+                        (ax     (if (> facing 0) (+ ex tw) (- 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))))))))
+        (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