;; 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 (%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 ))) (define (other-distance a b) (vec2-magnitude (vec2- (other-position a) (other-position b)))) ;; find closest other to given other (define (find-closest-other other others) (let ((other-others (remove (lambda (o) (equal? o other)) others))) (fold (lambda (a b) (if (< (other-distance a other) (other-distance b other)) a b)) (car other-others) (cdr other-others)))) ;; Generate inputs for the other based on the level and ;; the hero and other others. (define (determine-actions other level hero others) (let ((actions '()) (closest (find-closest-other other others))) ;; keep distance from each other (if (< (other-distance closest other) (* 2 level-cell-size)) (let ((diff (vec2- (other-position closest) (other-position other)))) (when (< (vec2-x diff) 0) (set! actions (cons 'right actions))) (when (> (vec2-x diff) 0) (set! actions (cons 'left actions))) (when (< (vec2-y diff) 0) (set! actions (cons 'up actions))) (when (> (vec2-y diff) 0) (set! actions (cons 'down actions))))) ;; move towards hero without falling off ladders (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")