124 lines
4.5 KiB
Scheme
124 lines
4.5 KiB
Scheme
;; 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 has-key?)
|
|
other?
|
|
(runner other-runner other-with-runner)
|
|
(has-key? other-has-key? other-with-key))
|
|
|
|
(define (make-other runner)
|
|
(%make-other runner #f))
|
|
|
|
(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")
|
|
|