aboutsummaryrefslogtreecommitdiff
path: root/tests/renderer-test.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/renderer-test.scm')
-rw-r--r--tests/renderer-test.scm158
1 files changed, 157 insertions, 1 deletions
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")
generated by cgit v1.2.3 (git 2.46.0) at 2026-04-21 00:08:08 +0000