diff options
| -rw-r--r-- | engine.scm | 78 | ||||
| -rw-r--r-- | tests/engine-test.scm | 157 |
2 files changed, 235 insertions, 0 deletions
diff --git a/engine.scm b/engine.scm new file mode 100644 index 0000000..5526e6c --- /dev/null +++ b/engine.scm @@ -0,0 +1,78 @@ +(module downstroke/engine * + +(import scheme + (chicken base) + (chicken keyword) + (prefix sdl2 "sdl2:") + (prefix sdl2-ttf "ttf:") + (prefix sdl2-image "img:") + defstruct + downstroke/world + downstroke/input + downstroke/assets + downstroke/renderer) + +;; ── Game struct ──────────────────────────────────────────────────────────── +;; defstruct auto-generates make-game, which we'll wrap with default values + +(defstruct game + title width height + window renderer + input ;; input-state record + input-config ;; input-config record + assets ;; asset registry (hash-table from assets.scm) + frame-delay + preload-hook ;; (lambda (game) ...) + create-hook ;; (lambda (game) ...) + update-hook ;; (lambda (game dt) ...) + render-hook ;; (lambda (game) ...) — post-render overlay + scene) ;; current scene struct; #f until create: runs + +;; Store the auto-generated constructor +(define make-game-raw make-game) + +;; ── Public constructor wrapper ───────────────────────────────────────────── + +(define (make-game #!key + (title "Downstroke Game") + (width 640) (height 480) + (frame-delay 16) + (input-config *default-input-config*) + (preload #f) (create #f) (update #f) (render #f)) + (make-game-raw + title: title + width: width + height: height + window: #f + renderer: #f + scene: #f + input: (create-input-state input-config) + input-config: input-config + assets: (make-asset-registry) + frame-delay: frame-delay + preload-hook: preload + create-hook: create + update-hook: update + render-hook: render)) + +;; ── Convenience accessors ────────────────────────────────────────────────── + +;; game-camera: derived from the current scene (only valid after create: runs) +(define (game-camera game) + (scene-camera (game-scene game))) + +;; game-asset: retrieve an asset by key +(define (game-asset game key) + (asset-ref (game-assets game) key)) + +;; game-asset-set!: store an asset by key +(define (game-asset-set! game key value) + (asset-set! (game-assets game) key value)) + +;; ── game-run! ────────────────────────────────────────────────────────────── +;; Stub — implemented in Task 4 + +(define (game-run! game) + (error "game-run! not yet implemented")) + +) ;; end module 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") |