;; Game state and logic for the hero entity (define-module (game model hero) #:use-module (ice-9 pretty-print) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-64) #: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-exercise hero-position hero-x hero-y hero-update hero-bloat hero-collides? )) (define-immutable-record-type (%make-hero runner exercise eaten) hero? (runner hero-runner hero-with-runner) (exercise hero-exercise hero-with-exercise) ;; calories-burned (eaten hero-eaten hero-with-eaten) ;; calories-eaten ) (define default-state 'fall) (define default-exercise 0) (define default-eaten 0) (define (hero-load level) "Create a hero at the position in the level map" (let ((runner (runner-load (level-find-hero level)))) (%make-hero runner default-exercise default-eaten))) (define (hero-x hero) "return the x coordinate as an integer" (runner-x (hero-runner hero))) (define (hero-y hero) "return the y coordinate as an integer" (runner-y (hero-runner hero)) ) (define (hero-state hero) "return the current state of the hero" (runner-state (hero-runner hero))) (define (hero-position hero) "return the current position of the hero" (runner-position (hero-runner hero))) (define (hero-bloat hero) "return the current bloat of the hero clamped to 0.5 and 2.0" (let* ((calories (- (hero-eaten hero) (hero-exercise hero))) (raw-bloat (+ 1.0 (/ calories 2000.0))) ) (cond ((< calories -1000) 0.5) ((> calories 1000) 2.0) (else raw-bloat) ))) (define (collides? a b) "return true if the position collides with the given position" (< (vec2-magnitude (vec2- a b)) level-cell-size)) (define (blocked-by-door? level keys position bloat) "return true if the hero is blocked by a door" (let ((door-position (level-find-goal level))) (and (collides? position door-position) (not (and (< 0.5 bloat 1.5) ;; healthy (null? keys)))))) ;; all keys collected (define climbing-exercise 0.5) (define moving-exercise 0.2) (define (calculate-exercise hero new-position) (let ((movement (vec2- new-position (hero-position hero)))) (+ (if (> (vec2-y movement) 0) climbing-exercise 0) (if (not (zero? (vec2-x movement))) moving-exercise 0)))) (define (hero-update hero level inputs keys calories-eaten dt) (let* ((new-runner (runner-update (hero-runner hero) level inputs dt)) (new-runner (if (blocked-by-door? level keys (runner-position new-runner) (hero-bloat hero)) (hero-runner hero) new-runner )) (exercise (calculate-exercise hero (runner-position new-runner)))) (-> hero (hero-with-runner new-runner) (hero-with-exercise (+ (hero-exercise hero) exercise)) (hero-with-eaten calories-eaten)))) (define (hero-collides? hero position) "return true if the hero collides with the given position" (collides? (hero-position hero) position)) ;; Tests (test-begin "hero-model") (let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW..HW\nWWWWW\n")) (hero (hero-load level)) (default-position (level-find-hero level))) (test-assert (hero? hero)) (test-equal default-exercise (hero-exercise hero)) (test-equal 1.5 (hero-exercise (hero-with-exercise hero 1.5))) (test-equal default-exercise (hero-exercise hero))) (let* ((level (level-parse "WWGWW\nW.H.W\nW.P.W\nWWWWW\n")) (hero (hero-load level)) (goal-position (level-find-goal level))) (test-assert (blocked-by-door? level '(dummy-key) goal-position 1.0)) (test-assert (not (blocked-by-door? level '() goal-position 1.0))) (test-assert (blocked-by-door? level '(dummy-key) (vec2- goal-position (vec2 0 -15)) 1.0)) (test-assert (not (blocked-by-door? level '(dummy-key) (vec2- goal-position (vec2 0 -16)) 1.0))) (test-assert (blocked-by-door? level '() goal-position 1.55)) ) (test-end "hero-model")