diff options
Diffstat (limited to 'tests/engine-test.scm')
| -rw-r--r-- | tests/engine-test.scm | 134 |
1 files changed, 67 insertions, 67 deletions
diff --git a/tests/engine-test.scm b/tests/engine-test.scm index bfa6d75..0ae56a9 100644 --- a/tests/engine-test.scm +++ b/tests/engine-test.scm @@ -46,9 +46,9 @@ (define (entity-ref entity key #!optional (default #f)) (let loop ((plist entity)) (cond - ((null? plist) (if (procedure? default) (default) default)) - ((eq? (car plist) key) (cadr plist)) - (else (loop (cddr plist))))))) + ((null? plist) (if (procedure? default) (default) default)) + ((eq? (car plist) key) (cadr plist)) + (else (loop (cddr plist))))))) (import (downstroke entity)) ;; --- Input module (mock) --- @@ -60,18 +60,18 @@ (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)) + 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) @@ -89,15 +89,15 @@ ;; Mock camera-follow - returns a new camera (define (camera-follow camera entity viewport-w viewport-h) (update-camera camera - x: (max 0 (- (entity-ref entity #:x 0) (/ viewport-w 2))) - y: (max 0 (- (entity-ref entity #:y 0) (/ viewport-h 2))))) + x: (max 0 (- (entity-ref entity #:x 0) (/ viewport-w 2))) + y: (max 0 (- (entity-ref entity #:y 0) (/ viewport-h 2))))) ;; Mock scene-find-tagged - finds first entity with matching tag (define (scene-find-tagged scene tag) (let loop ((entities (scene-entities scene))) (cond - ((null? entities) #f) - ((member tag (entity-ref (car entities) #:tags '())) (car entities)) - (else (loop (cdr entities)))))) + ((null? entities) #f) + ((member tag (entity-ref (car entities) #:tags '())) (car entities)) + (else (loop (cdr entities)))))) (define (scene-map-entities scene . procs) (let loop ((ps procs) (es (scene-entities scene))) (if (null? ps) @@ -156,36 +156,36 @@ (test-group "make-game defaults" (let ((g (make-game))) (test "default title" - "Downstroke Game" - (game-title g)) + "Downstroke Game" + (game-title g)) (test "default width" - 640 - (game-width g)) + 640 + (game-width g)) (test "default height" - 480 - (game-height g)) + 480 + (game-height g)) (test "default frame-delay" - 16 - (game-frame-delay g)) + 16 + (game-frame-delay g)) (test "scene starts as #f" - #f - (game-scene g)) + #f + (game-scene g)) (test "window starts as #f" - #f - (game-window g)) + #f + (game-window g)) (test "renderer starts as #f" - #f - (game-renderer g)) + #f + (game-renderer g)) (test-assert "assets registry is created" (game-assets g)) (test-assert "input state is created" (game-input g)) (test "debug? defaults to #f" - #f - (game-debug? g)) + #f + (game-debug? g)) (test "scale defaults to 1" - 1 - (game-scale g)))) + 1 + (game-scale g)))) (test-group "make-game with keyword args" (let ((g (make-game title: "My Game" width: 320 height: 240 frame-delay: 33))) @@ -196,22 +196,22 @@ (test-group "make-game debug? keyword" (test "debug? defaults to #f" - #f - (game-debug? (make-game))) + #f + (game-debug? (make-game))) (test "debug? can be set to #t" - #t - (game-debug? (make-game debug?: #t)))) + #t + (game-debug? (make-game debug?: #t)))) (test-group "make-game scale keyword" (test "scale defaults to 1" - 1 - (game-scale (make-game))) + 1 + (game-scale (make-game))) (test "scale can be set to 2" - 2 - (game-scale (make-game scale: 2))) + 2 + (game-scale (make-game scale: 2))) (test "scale can be set to 3" - 3 - (game-scale (make-game scale: 3))) + 3 + (game-scale (make-game scale: 3))) (import (chicken condition)) (let ((caught #f)) (condition-case (make-game scale: 0) @@ -229,16 +229,16 @@ (test-group "game-asset and game-asset-set!" (let ((g (make-game))) (test "missing key returns #f" - #f - (game-asset g 'no-such-asset)) + #f + (game-asset g 'no-such-asset)) (game-asset-set! g 'my-font 'font-object) (test "stored asset is retrievable" - 'font-object - (game-asset g 'my-font)) + 'font-object + (game-asset g 'my-font)) (game-asset-set! g 'my-font 'updated-font) (test "overwrite replaces asset" - 'updated-font - (game-asset g 'my-font)))) + 'updated-font + (game-asset g 'my-font)))) (test-group "make-game hooks default to #f" (let ((g (make-game))) @@ -256,17 +256,17 @@ (test-group "game-camera" (let* ((cam (make-camera x: 10 y: 20)) (scene (make-scene entities: '() - tilemap: #f - tileset: #f - camera: cam - tileset-texture: #f - camera-target: #f - background: #f)) + tilemap: #f + tileset: #f + camera: cam + tileset-texture: #f + camera-target: #f + background: #f)) (g (make-game))) (game-scene-set! g scene) (test "returns scene camera" - cam - (game-camera g)))) + cam + (game-camera g)))) (test-group "make-game-state" (let ((s (make-game-state create: (lambda (g) 'created) @@ -283,7 +283,7 @@ (let* ((created? #f) (game (make-game)) (state (make-game-state - create: (lambda (g) (set! created? #t))))) + create: (lambda (g) (set! created? #t))))) (game-add-state! game 'play state) (test "active-state defaults to #f" #f (game-active-state game)) (game-start-state! game 'play) @@ -297,16 +297,16 @@ (test-group "scene engine-update" (test "scene engine-update defaults to #f" - #f - (scene-engine-update (make-scene entities: '() tilemap: #f camera-target: #f))) + #f + (scene-engine-update (make-scene entities: '() tilemap: #f camera-target: #f))) (let* ((my-eu (lambda (game dt) #t)) (s (make-scene entities: '() tilemap: #f camera-target: #f engine-update: my-eu))) (test-assert "custom engine-update stored on scene" (procedure? (scene-engine-update s)))) (let ((s (make-scene entities: '() tilemap: #f camera-target: #f engine-update: 'none))) (test "engine-update: 'none disables pipeline" - 'none - (scene-engine-update s)))) + 'none + (scene-engine-update s)))) (test-end "engine") (test-exit) |