Initial port of macroknight to an engine

1 files changed, 92 insertions, 0 deletions

diff --git a/tests/renderer-test.scm b/tests/renderer-test.scm
new file mode 100644
index 0000000..a8fdeed
--- /dev/null
+++ b/tests/renderer-test.scm
@@ -0,0 +1,92 @@
+;; Load base deps
+(import scheme
+        (chicken base)
+        (chicken keyword)
+        (only srfi-1 fold iota for-each)
+        defstruct
+        srfi-64)
+
+;; Mock tilemap module
+(module tilemap *
+  (import scheme (chicken base) defstruct)
+  (defstruct tileset tilewidth tileheight spacing tilecount columns image-source image)
+  (defstruct layer name width height map)
+  (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))
+(import tilemap)
+
+;; Mock sdl2
+(module sdl2 *
+  (import scheme (chicken base))
+  (define (make-rect x y w h) (list x y w h))
+  (define (render-copy! . args) #f)
+  (define (render-copy-ex! . args) #f)
+  (define (create-texture-from-surface . args) #f))
+(import (prefix sdl2 "sdl2:"))
+
+;; Mock sdl2-ttf
+(module sdl2-ttf *
+  (import scheme (chicken base))
+  (define (render-text-solid . args) #f)
+  (define (size-utf8 . args) (values 0 0)))
+(import (prefix sdl2-ttf "ttf:"))
+
+;; Load entity module
+(include "entity.scm")
+(import entity)
+
+;; Load world module
+(include "world.scm")
+(import world)
+
+;; Load renderer module
+(include "renderer.scm")
+(import renderer)
+
+(test-begin "renderer")
+
+(test-group "entity-screen-coords"
+  (let* ((cam (make-camera x: 10 y: 20))
+         (e   (list #:x 50 #:y 80 #:width 16 #:height 16)))
+    (test-equal "subtracts camera offset from x"
+                40
+                (car (entity-screen-coords e cam)))
+    (test-equal "subtracts camera offset from y"
+                60
+                (cadr (entity-screen-coords e cam)))
+    (test-equal "preserves width"
+                16
+                (caddr (entity-screen-coords e cam)))
+    (test-equal "preserves height"
+                16
+                (cadddr (entity-screen-coords e cam))))
+
+  (let* ((cam (make-camera x: 0 y: 0))
+         (e   (list #:x 100.7 #:y 200.3 #:width 16 #:height 16)))
+    (test-equal "floors fractional x"
+                100
+                (car (entity-screen-coords e cam)))
+    (test-equal "floors fractional y"
+                200
+                (cadr (entity-screen-coords e cam))))
+
+  (let* ((cam (make-camera x: 0 y: 0))
+         (e   (list #:x 0 #:y 0 #:width 32 #:height 32)))
+    (test-equal "zero camera, zero position"
+                '(0 0 32 32)
+                (entity-screen-coords e cam))))
+
+(test-group "entity-flip"
+  (test-equal "facing 1: no flip"
+              '()
+              (entity-flip (list #:facing 1)))
+  (test-equal "facing -1: horizontal flip"
+              '(horizontal)
+              (entity-flip (list #:facing -1)))
+  (test-equal "no facing key: defaults to no flip"
+              '()
+              (entity-flip (list #:x 0))))
+
+(test-end "renderer")