diff --git a/game/model/hero.scm b/game/model/hero.scm index 1fee556..2d49f16 100644 --- a/game/model/hero.scm +++ b/game/model/hero.scm @@ -8,21 +8,21 @@ #:use-module (chickadee math vector) #:use-module (game util pipe) #:use-module (game model level) + #:use-module (game model runner) #:export (hero-load hero-state hero-bloat - hero-position hero-with-position - hero-x hero-with-x - hero-y hero-with-y + hero-position + hero-x + hero-y hero-update )) (define-immutable-record-type - (%make-hero position state bloat) + (%make-hero runner bloat) hero? - (position hero-position hero-with-position) - (state hero-state hero-with-state) ;; 'go-left 'go-right 'climb 'fall 'stationary + (runner hero-runner hero-with-runner) (bloat hero-bloat hero-with-bloat) ;; 0.0 to 2.0, how much the hero is inflated ) @@ -30,75 +30,30 @@ (define default-bloat 1.0) (define (hero-load level) - (let ((initial-position (level-find-hero level))) - (%make-hero initial-position default-state default-bloat))) + "Create a hero at the position in the level map" + (let ((runner (runner-load (level-find-hero level)))) + (%make-hero runner default-bloat))) (define (hero-x hero) "return the x coordinate as an integer" - (inexact->exact (floor (vec2-x (hero-position hero))))) + (runner-x (hero-runner hero))) (define (hero-y hero) "return the y coordinate as an integer" - (inexact->exact (floor (vec2-y (hero-position hero))))) + (runner-y (hero-runner hero)) + ) -(define (hero-with-x hero x) - (hero-with-position hero (vec2 x (hero-y hero)))) +(define (hero-state hero) + "return the current state of the hero" + (runner-state (hero-runner hero))) -(define (hero-with-y hero y) - (hero-with-position hero (vec2 (hero-x hero) y))) +(define (hero-position hero) + "return the current position of the hero" + (runner-position (hero-runner hero))) -;; return next state of hero -;; @returns 'go-left 'go-right 'climb 'fall 'stationary -(define (next-state hero level inputs) - (let* ((position (hero-position hero)) - (state (hero-state hero)) - (tile-below (level-tile-at level (vec2 (hero-x hero) (1- (hero-y hero)))))) - (cond - ((equal? (level-tile-at level position) 'ladder) 'climb) - ((> (floor-remainder (hero-y hero) level-cell-size) 0) 'fall) - ((equal? tile-below 'empty) 'fall) - (else (cond - ((member 'left inputs) 'go-left) - ((member 'right inputs) 'go-right) - (else 'stationary)))))) - -(define (input->movement input distance) - (case input - ((left) (vec2 (- distance) 0)) - ((right) (vec2 distance 0)) - ((up) (vec2 0 distance)) - ((down) (vec2 0 (- distance))) - (else (vec2 0 0)))) - - -(define (next-position position state inputs distance) - (case state - ((fall) (vec2- position (vec2 0 distance))) - ((go-left) (vec2- position (vec2 distance 0))) - ((go-right) (vec2+ position (vec2 distance 0))) - ((stationary) position) - ((climb) (fold (lambda (input movement) - (vec2+ movement (input->movement input distance))) - position - inputs)) - (else position) - )) - -(define speed 50.0) - (define (hero-update hero level inputs dt) - (let* ((state (next-state hero level inputs)) - (distance (* dt speed)) - (position (next-position (hero-position hero) (hero-state hero) inputs distance)) - (tile (level-tile-at level position)) - ) - (hero-with-state - (if (member tile '(empty ladder other)) - (hero-with-position hero position) - (hero-with-position hero (vec2 (hero-x hero) (hero-y hero))) ;; round position - ) - state))) + (hero-with-runner hero (runner-update (hero-runner hero) level inputs dt))) @@ -109,57 +64,10 @@ (hero (hero-load level)) (default-position (level-find-hero level))) (test-assert (hero? hero)) - (test-equal default-position (hero-position hero)) - (test-equal default-state (hero-state hero)) (test-equal default-bloat (hero-bloat hero)) - (test-equal (vec2 10 20) (hero-position (hero-with-position hero (vec2 10 20)))) - (test-equal default-position (hero-position hero)) - (test-equal 'go-left (hero-state (hero-with-state hero 'go-left))) - (test-equal default-state (hero-state hero)) (test-equal 1.5 (hero-bloat (hero-with-bloat hero 1.5))) (test-equal default-bloat (hero-bloat hero)) - (test-equal 16 (hero-x (hero-with-position hero (vec2 16.34 20.78)))) - (test-equal 20 (hero-y (hero-with-position hero (vec2 16.34 20.78)))) - - (test-equal 'fall (next-state hero level '())) - (let ((hero (hero-with-position hero (vec2 16 16)))) - (test-equal 'stationary (next-state hero level '())) - (test-equal 'go-left (next-state hero level '(left))) - (test-equal 'go-right (next-state hero level '(right)))) - (let ((hero (hero-with-position hero (vec2 48 32)))) - (test-equal 'stationary (next-state hero level '()))) - (let ((hero (hero-with-position hero (vec2 48 31)))) - (test-equal 'climb (next-state hero level '()))) - (let ((hero (hero-with-position hero (vec2 32 31)))) - (test-equal 'fall (next-state hero level '()))) - - (test-equal (vec2 32.0 31.0) (next-position (vec2 32.0 32.0) 'fall '() 1.0)) - - (test-equal (vec2 31.0 32.0) (next-position (vec2 32.0 32.0) 'go-left '() 1.0)) - (test-equal (vec2 33.0 32.0) (next-position (vec2 32.0 32.0) 'go-right '() 1.0)) - (test-equal (vec2 32.0 32.0) (next-position (vec2 32.0 32.0) 'stationary '() 1.0)) - - - (test-equal (vec2 31.0 32.0) (next-position (vec2 32.0 32.0) 'climb '(left) 1.0)) - (test-equal (vec2 33.0 32.0) (next-position (vec2 32.0 32.0) 'climb '(right) 1.0)) - (test-equal (vec2 32.0 31.0) (next-position (vec2 32.0 32.0) 'climb '(down) 1.0)) - (test-equal (vec2 32.0 33.0) (next-position (vec2 32.0 32.0) 'climb '(up) 1.0)) - - - (test-equal - (vec2 32.0 16.0) - (hero-position - (hero-update - (hero-with-state - (hero-with-position hero (vec2 32 16.3)) - 'fall) - level - '() - 0.017 - ) - )) - ) + (test-end "hero-model")) -(test-end "hero-model") diff --git a/game/model/runner.scm b/game/model/runner.scm index 49f06b3..f2a3828 100644 --- a/game/model/runner.scm +++ b/game/model/runner.scm @@ -47,6 +47,7 @@ ;; return next state of runner ;; @returns 'go-left 'go-right 'climb 'fall 'stationary (define (next-state runner level inputs) + "return the next state of the runner based on the current state, level and inputs" (let* ((position (runner-position runner)) (state (runner-state runner)) (tile-below (level-tile-at level (vec2 (runner-x runner) (1- (runner-y runner))))))