(import scheme (chicken base) (chicken keyword) srfi-64 defstruct (srfi 69)) ;; --- 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 '() '())) (define (input-state-update state events config) state) (define (input-held? state action) #f)) (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) ;; --- Real deps --- (import simple-logger) ;; required by input.scm (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-group "game-camera" (let* ((cam (make-camera x: 10 y: 20)) (scene (make-scene entities: '() tilemap: #f camera: cam tileset-texture: #f)) (g (make-game))) (game-scene-set! g scene) (test-equal "returns scene camera" cam (game-camera g)))) (test-group "make-game-state" (let ((s (make-game-state create: (lambda (g) 'created) update: (lambda (g dt) 'updated) render: (lambda (g) 'rendered)))) (test-assert "state has create hook" (state-hook s #:create)) (test-assert "state has update hook" (state-hook s #:update)) (test-assert "state has render hook" (state-hook s #:render))) (let ((s (make-game-state))) (test-equal "default state hooks are #f" #f (state-hook s #:create)) (test-equal "default state update is #f" #f (state-hook s #:update)))) (test-group "game-add-state! and game-start-state!" (let* ((created? #f) (game (make-game)) (state (make-game-state create: (lambda (g) (set! created? #t))))) (game-add-state! game 'play state) (test-equal "active-state defaults to #f" #f (game-active-state game)) (game-start-state! game 'play) (test-equal "active-state set after start" 'play (game-active-state game)) (test-assert "create hook called on start" created?))) (test-group "game states defaults" (let ((game (make-game))) (test-assert "states is a hash-table" (hash-table? (game-states game))) (test-equal "active-state defaults to #f" #f (game-active-state game)))) (test-end "engine")