Initial port of macroknight to an engine

1 files changed, 88 insertions, 0 deletions

diff --git a/renderer.scm b/renderer.scm
new file mode 100644
index 0000000..ad894d0
--- /dev/null
+++ b/renderer.scm
@@ -0,0 +1,88 @@
+(module renderer
+    *
+  (import scheme
+          (chicken base)
+          (only srfi-1 iota for-each)
+          (prefix sdl2 "sdl2:")
+          (prefix sdl2-ttf "ttf:")
+          entity
+          tilemap
+          world)
+
+  ;; --- 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 ---
+
+  (define (draw-entity renderer camera tileset tileset-texture entity)
+    (let ((tile-id (entity-ref entity #:tile-id #f)))
+      (when tile-id
+        (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)))))
+
+  (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))))
+
+) ;; end module renderer