bloatrunner/game/model/hero.scm

;; 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 <hero>
  (%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")