diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/engine-test.scm | 157 |
1 files changed, 157 insertions, 0 deletions
diff --git a/tests/engine-test.scm b/tests/engine-test.scm new file mode 100644 index 0000000..56b9a04 --- /dev/null +++ b/tests/engine-test.scm @@ -0,0 +1,157 @@ +(import scheme (chicken base) (chicken keyword) srfi-64 defstruct) + +;; --- Mocks --- + +(module sdl2 * + (import scheme (chicken base)) + (define (set-main-ready!) #f) + (define (init! . args) #f) + (define (quit! . args) #f) + (define (get-ticks) 0) + (define (delay! ms) #f) + (define (pump-events!) #f) + (define (has-events?) #f) + (define (make-event) #f) + (define (poll-event! e) #f) + (define (num-joysticks) 0) + (define (is-game-controller? i) #f) + (define (game-controller-open! i) #f) + (define (create-window! . args) 'mock-window) + (define (create-renderer! . args) 'mock-renderer) + (define (destroy-window! . args) #f) + (define (render-clear! . args) #f) + (define (render-present! . args) #f) + (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:")) + +(module sdl2-ttf * + (import scheme (chicken base)) + (define (init!) #f)) +(import (prefix sdl2-ttf "ttf:")) + +(module sdl2-image * + (import scheme (chicken base)) + (define (init! . args) #f)) +(import (prefix sdl2-image "img:")) + +;; --- Entity module (mock minimal structs) --- +(module downstroke/entity * + (import scheme (chicken base))) +(import downstroke/entity) + +;; --- Input module (mock) --- +(module downstroke/input * + (import scheme (chicken base) defstruct) + (defstruct input-config + actions keyboard-map joy-button-map controller-button-map + joy-axis-bindings controller-axis-bindings deadzone) + (define-record input-state current previous) + (define *default-input-config* + (make-input-config + actions: '(up down left right a b start select quit) + keyboard-map: '((w . up) (up . up) (s . down) (down . down) + (a . left) (left . left) (d . right) (right . right) + (j . a) (z . a) (k . b) (x . b) + (return . start) (escape . quit)) + joy-button-map: '((0 . a) (1 . b) (7 . start) (6 . select)) + controller-button-map: '((a . a) (b . b) (start . start) (back . select) + (dpad-up . up) (dpad-down . down) + (dpad-left . left) (dpad-right . right)) + joy-axis-bindings: '((0 right left) (1 down up)) + controller-axis-bindings: '((left-x right left) (left-y down up)) + deadzone: 8000)) + (define (create-input-state config) + (make-input-state '() '()))) +(import downstroke/input) + +;; --- World module (mock) --- +(module downstroke/world * + (import scheme (chicken base) defstruct) + (defstruct camera x y) + (defstruct scene entities tilemap camera tileset-texture)) +(import downstroke/world) + +;; --- Assets module (real) --- +(include "assets.scm") +(import downstroke/assets) + +;; --- Renderer module (mock) --- +(module downstroke/renderer * + (import scheme (chicken base)) + (define (render-scene! . args) #f)) +(import downstroke/renderer) + +;; --- Engine module (real) --- +(include "engine.scm") +(import downstroke/engine) + +;; --- Tests --- + +(test-begin "engine") + +(test-group "make-game defaults" + (let ((g (make-game))) + (test-equal "default title" + "Downstroke Game" + (game-title g)) + (test-equal "default width" + 640 + (game-width g)) + (test-equal "default height" + 480 + (game-height g)) + (test-equal "default frame-delay" + 16 + (game-frame-delay g)) + (test-equal "scene starts as #f" + #f + (game-scene g)) + (test-equal "window starts as #f" + #f + (game-window g)) + (test-equal "renderer starts as #f" + #f + (game-renderer g)) + (test-assert "assets registry is created" + (game-assets g)) + (test-assert "input state is created" + (game-input g)))) + +(test-group "make-game with keyword args" + (let ((g (make-game title: "My Game" width: 320 height: 240 frame-delay: 33))) + (test-equal "custom title" "My Game" (game-title g)) + (test-equal "custom width" 320 (game-width g)) + (test-equal "custom height" 240 (game-height g)) + (test-equal "custom frame-delay" 33 (game-frame-delay g)))) + +(test-group "game-asset and game-asset-set!" + (let ((g (make-game))) + (test-equal "missing key returns #f" + #f + (game-asset g 'no-such-asset)) + (game-asset-set! g 'my-font 'font-object) + (test-equal "stored asset is retrievable" + 'font-object + (game-asset g 'my-font)) + (game-asset-set! g 'my-font 'updated-font) + (test-equal "overwrite replaces asset" + 'updated-font + (game-asset g 'my-font)))) + +(test-group "make-game hooks default to #f" + (let ((g (make-game))) + (test-equal "preload-hook is #f" #f (game-preload-hook g)) + (test-equal "create-hook is #f" #f (game-create-hook g)) + (test-equal "update-hook is #f" #f (game-update-hook g)) + (test-equal "render-hook is #f" #f (game-render-hook g)))) + +(test-group "make-game accepts hook lambdas" + (let* ((called #f) + (g (make-game update: (lambda (game dt) (set! called #t))))) + (test-assert "update hook is stored" + (procedure? (game-update-hook g))))) + +(test-end "engine") |
