bloatrunner/game/model/other.scm

;; Game state and logic for the other entity
(define-module (game model other)
  #: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 hero)
  #:use-module (game model level)
  #:use-module (game model runner)
  #:export (other-load-others
            other-state 
            other-bloat
            other-position
            other-x 
            other-y
            other-update
            ))


;; The enemies in this game are called "others" because they are not you
;; They are represented by a runner and try to reach the player to give
;; unwelcome advice unwittingly killing the player with cringe.
(define-immutable-record-type <other>
  (%make-other runner)
  other?
  (runner other-runner other-with-runner)
  )

(define default-state 'fall)
(define default-bloat 1.0)

(define (other-load-others level)
  "Create a other at the position in the level map"
  (map 
   (compose %make-other runner-load)
   (level-find-others level)))

(define (other-x other)
  "return the x coordinate as an integer"
  (runner-x (other-runner other)))

(define (other-y other)
  "return the y coordinate as an integer"
  (runner-y (other-runner other))
  )

(define (other-state other)
  "return the current state of the other"
  (runner-state (other-runner other)))

(define (other-position other)
  "return the current position of the other"
  (runner-position (other-runner other)))

(define (safe-ladder-position? position level)
  "return true if the other can move left or right without falling of the ladder"
  (let ((this-block (level-tile-at level position))
        (block-left (level-tile-at level (vec2+ position (vec2 -1 0))))
        (block-down-left (level-tile-at level (vec2+ position (vec2 -1 -1))))
        (block-right (level-tile-at level (vec2+ position (vec2 1 0))))
        (block-down-right (level-tile-at level (vec2+ position (vec2 1 -1)))))
    (if (equal? this-block 'ladder) 
        (and 
         (not (equal? block-left 'brick))
         (not (equal? block-right 'brick))
         (member block-down-left '(brick ladder))
         (member block-down-right '(brick ladder)))
        #t                              ;; if not on ladder, it's safe
        )))

;; Generate inputs for the other based on the level and
;; the hero and other others.
(define (determine-actions other level hero others)
  (let ((actions '()))
    (when  (safe-ladder-position? (other-position other) level) 
      (when (< (hero-x hero) (other-x other))
        (set! actions (cons 'left actions)))
      (when (> (hero-x hero) (other-x other))
        (set! actions (cons 'right actions))))
    (when (< (hero-y hero) (other-y other))
      (set! actions (cons 'down actions)))
    (when (> (hero-y hero) (other-y other))
      (set! actions (cons 'up actions)))
    actions))

(define (other-update other level hero others dt)
(let ((inputs (determine-actions other level hero others)))
  (other-with-runner other (runner-update (other-runner other) level inputs dt))))



;; Tests
(test-begin "other-model")

(let* ((level (level-parse "WWWWW\nW...W\nWO.OW\nW..HW\nWWWWW\n"))
       (others (other-load-others level)))
  (test-assert (other? (car others)))
  (test-equal 2 (length others))
  )

(let* ((level (level-parse "WWWWWWW\nW...H...W\nW.BBHBB.W\nW...H...W\nW..H..W\nWBBBBBW\nWWWWWWW\n"))
       (others (other-load-others level)))
  (test-assert (safe-ladder-position? (vec2 32 32) level)) ;; not on ladder is safe
  (test-assert (safe-ladder-position? (vec2 56 40) level)) ;; middle of ladder is safe
  
  (test-assert (not (safe-ladder-position? (vec2 64 48) level))) ;; left edge of ladder is unsafe
  (test-assert (not (safe-ladder-position? (vec2 79 48) level))) ;; right edge of ladder is unsafe
  
  (test-assert (not (safe-ladder-position? (vec2 64 48) level))) ;; edge inside platform is unsafe
  (test-assert (not (safe-ladder-position? (vec2 79 48) level))) ;; edge inside platform is unsafe
  (test-assert (not (safe-ladder-position? (vec2 64 63) level))) ;; edge inside platform is unsafe
  (test-assert (not (safe-ladder-position? (vec2 79 63) level))) ;; edge inside platform is unsafe
  
  (test-assert (safe-ladder-position? (vec2 64 80) level)) ;; edge at platform is safe
  (test-assert (safe-ladder-position? (vec2 79 80) level)) ;; edge at platform is safe
  )

(test-end "other-model")