render others and integrate model in main

This commit is contained in:
Peter Tillemans 2024-05-22 12:53:01 +02:00
parent 7a6fa94ae3
commit 8332dca1fc
8 changed files with 153 additions and 77 deletions

View file

@ -5,7 +5,7 @@
WWWWGWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW WWWWGWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW
W H W W H W
W O H O W W O H O W
W H W W H H W
W O BBBBBBBBBBBBBBBBBBBBBBBBBBHB O W - W O BBBBBBBBBBBBBBBBBBBBBBBBBBHB O W -
W H W W H W
W H W W H W
@ -21,7 +21,7 @@ W H W
W H W W H W
W H W W H W
W H W W H W
W H W - W H H W -
W P BHBBBBBBB W W P BHBBBBBBB W
W H W W H W
W H W W H W

View file

@ -2,8 +2,10 @@
#:use-module (ice-9 pretty-print) #:use-module (ice-9 pretty-print)
#:use-module (game model level) #:use-module (game model level)
#:use-module (game model hero) #:use-module (game model hero)
#:use-module (game model other)
#:use-module (game render level) #:use-module (game render level)
#:use-module (game render hero) #:use-module (game render hero)
#:use-module (game render other)
#:use-module (chickadee) #:use-module (chickadee)
#:use-module (chickadee math rect) #:use-module (chickadee math rect)
#:use-module (chickadee math vector) #:use-module (chickadee math vector)
@ -19,24 +21,29 @@
(define level #f) (define level #f)
(define repl #f) (define repl #f)
(define hero #f) (define hero #f)
(define others #f)
(define inputs '()) (define inputs '())
(define (load) (define (load)
(render-level-load) (render-level-load)
(render-hero-load) (render-hero-load)
(render-other-load)
(set! level (level-parse-file "assets/levels/level-1.map")) (set! level (level-parse-file "assets/levels/level-1.map"))
(render-level-set! level) (render-level-set! level)
(set! hero (hero-load level)) (set! hero (hero-load level))
(set! others (other-load-others level))
(set! repl (spawn-coop-repl-server))) (set! repl (spawn-coop-repl-server)))
(define (update dt) (define (update dt)
(poll-coop-repl-server repl) (poll-coop-repl-server repl)
(set! hero (hero-update hero level inputs dt)) (set! hero (hero-update hero level inputs dt))
(set! others (map (lambda (other) (other-update other level dt)) others))
) )
(define (draw _alpha) (define (draw _alpha)
(render-level-draw level) (render-level-draw level)
(render-hero hero) (render-hero hero)
(for-each render-other others)
) )
(define (set-add set item) (define (set-add set item)

View file

@ -58,7 +58,7 @@
;; Tests ;; Tests
[test-begin "hero-model"] (test-begin "hero-model")
(let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW..HW\nWWWWW\n")) (let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW..HW\nWWWWW\n"))
(hero (hero-load level)) (hero (hero-load level))
@ -67,7 +67,7 @@
(test-equal default-bloat (hero-bloat hero)) (test-equal default-bloat (hero-bloat hero))
(test-equal 1.5 (hero-bloat (hero-with-bloat hero 1.5))) (test-equal 1.5 (hero-bloat (hero-with-bloat hero 1.5)))
(test-equal default-bloat (hero-bloat hero)) (test-equal default-bloat (hero-bloat hero)))
(test-end "hero-model")) (test-end "hero-model")

View file

@ -15,8 +15,10 @@
level-parse-file level-parse-file
level-parse level-parse
level-tile-at level-tile-at
level-find-hero
level-cell-size level-cell-size
level-find-hero
level-find-others
level-tile-blocked?
)) ))
(define-record-type <level> (define-record-type <level>
@ -84,6 +86,9 @@
(y (vec2-y position))) (y (vec2-y position)))
(level-tile-at-row-col level (coord->cell y) (coord->cell x)))) (level-tile-at-row-col level (coord->cell y) (coord->cell x))))
(define (level-tile-blocked? level position)
(memq (level-tile-at level position) '(wall brick)))
(define (gen-coords a b) (define (gen-coords a b)
(append-map (append-map
(lambda (r) (lambda (r)

View file

@ -1,5 +1,5 @@
;; Game state and logic for the hero entity ;; Game state and logic for the other entity
(define-module (game model hero) (define-module (game model other)
#:use-module (ice-9 pretty-print) #:use-module (ice-9 pretty-print)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
@ -9,65 +9,63 @@
#:use-module (game util pipe) #:use-module (game util pipe)
#:use-module (game model level) #:use-module (game model level)
#:use-module (game model runner) #:use-module (game model runner)
#:export (hero-load #:export (other-load-others
hero-state other-state
hero-bloat other-bloat
hero-position other-position
hero-x other-x
hero-y other-y
hero-update other-update
)) ))
(define-immutable-record-type <hero> (define-immutable-record-type <other>
(%make-hero runner bloat) (%make-other runner)
hero? other?
(runner hero-runner hero-with-runner) (runner other-runner other-with-runner)
(bloat hero-bloat hero-with-bloat) ;; 0.0 to 2.0, how much the hero is inflated
) )
(define default-state 'fall) (define default-state 'fall)
(define default-bloat 1.0) (define default-bloat 1.0)
(define (hero-load level) (define (other-load-others level)
"Create a hero at the position in the level map" "Create a other at the position in the level map"
(let ((runner (runner-load (level-find-hero level)))) (map
(%make-hero runner default-bloat))) (compose %make-other runner-load)
(level-find-others level)))
(define (hero-x hero) (define (other-x other)
"return the x coordinate as an integer" "return the x coordinate as an integer"
(runner-x (hero-runner hero))) (runner-x (other-runner other)))
(define (hero-y hero) (define (other-y other)
"return the y coordinate as an integer" "return the y coordinate as an integer"
(runner-y (hero-runner hero)) (runner-y (other-runner other))
) )
(define (hero-state hero) (define (other-state other)
"return the current state of the hero" "return the current state of the other"
(runner-state (hero-runner hero))) (runner-state (other-runner other)))
(define (hero-position hero) (define (other-position other)
"return the current position of the hero" "return the current position of the other"
(runner-position (hero-runner hero))) (runner-position (other-runner other)))
(define (hero-update hero level inputs dt) (define (other-update other level dt)
(hero-with-runner hero (runner-update (hero-runner hero) level inputs dt))) (other-with-runner other (runner-update (other-runner other) level '() dt)))
;; Tests ;; Tests
[test-begin "hero-model"] (test-begin "other-model")
(let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW..HW\nWWWWW\n")) (let* ((level (level-parse "WWWWW\nW...W\nWO.OW\nW..HW\nWWWWW\n"))
(hero (hero-load level)) (others (other-load-others level)))
(default-position (level-find-hero level))) (test-assert (other? (car others)))
(test-assert (hero? hero)) (test-equal 2 (length others))
(test-equal default-bloat (hero-bloat hero)) )
(test-equal 1.5 (hero-bloat (hero-with-bloat hero 1.5)))
(test-equal default-bloat (hero-bloat hero))
(test-end "hero-model")) (test-end "other-model")

View file

@ -50,11 +50,11 @@
"return the next state of the runner based on the current state, level and inputs" "return the next state of the runner based on the current state, level and inputs"
(let* ((position (runner-position runner)) (let* ((position (runner-position runner))
(state (runner-state runner)) (state (runner-state runner))
(tile-below (level-tile-at level (vec2 (runner-x runner) (1- (runner-y runner)))))) (tile-below-blocked? (level-tile-blocked? level (vec2 (runner-x runner) (1- (runner-y runner))))))
(cond (cond
((equal? (level-tile-at level position) 'ladder) 'climb) ((equal? (level-tile-at level position) 'ladder) 'climb)
((> (floor-remainder (runner-y runner) level-cell-size) 0) 'fall) ((> (floor-remainder (runner-y runner) level-cell-size) 0) 'fall)
((equal? tile-below 'empty) 'fall) ((not tile-below-blocked?) 'fall)
(else (cond (else (cond
((member 'left inputs) 'go-left) ((member 'left inputs) 'go-left)
((member 'right inputs) 'go-right) ((member 'right inputs) 'go-right)
@ -69,14 +69,26 @@
(else (vec2 0 0)))) (else (vec2 0 0))))
(define (next-position position state inputs distance) (define (round-position pos)
(vec2 (inexact->exact (floor (vec2-x pos)))
(inexact->exact (floor (vec2-y pos)))))
(define (safe-move level pos move)
(let ((new-pos (vec2+ pos move)))
(if (level-tile-blocked? level new-pos)
(round-position pos) ;; snap to grid on collision with hard scenery
new-pos
)))
(define (next-position level position state inputs distance)
(case state (case state
((fall) (vec2- position (vec2 0 distance))) ((fall) (safe-move level position (vec2 0 (- distance))))
((go-left) (vec2- position (vec2 distance 0))) ((go-left) (safe-move level position (vec2 (- distance) 0)))
((go-right) (vec2+ position (vec2 distance 0))) ((go-right) (safe-move level position (vec2 distance 0)))
((stationary) position) ((stationary) position)
((climb) (fold (lambda (input movement) ((climb) (fold (lambda (input pos)
(vec2+ movement (input->movement input distance))) (safe-move level pos (input->movement input distance)))
position position
inputs)) inputs))
(else position) (else position)
@ -87,20 +99,16 @@
(define (runner-update runner level inputs dt) (define (runner-update runner level inputs dt)
(let* ((state (next-state runner level inputs)) (let* ((state (next-state runner level inputs))
(distance (* dt speed)) (distance (* dt speed))
(position (next-position (runner-position runner) (runner-state runner) inputs distance)) (position (next-position level (runner-position runner) (runner-state runner) inputs distance))
(tile (level-tile-at level position))
) )
(runner-with-state (-> runner
(if (member tile '(empty ladder other)) (runner-with-state state)
(runner-with-position runner position) (runner-with-position position))))
(runner-with-position runner (vec2 (runner-x runner) (runner-y runner))) ;; round position
)
state)))
;; Tests ;; Tests
[test-begin "runner-model"] (test-begin "runner-model")
(let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW..HW\nWWWWW\n")) (let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW..HW\nWWWWW\n"))
(default-position (vec2 32 32)) (default-position (vec2 32 32))
@ -129,21 +137,20 @@
(let ((runner (runner-with-position runner (vec2 32 31)))) (let ((runner (runner-with-position runner (vec2 32 31))))
(test-equal 'fall (next-state runner level '()))) (test-equal 'fall (next-state runner level '())))
(test-equal (vec2 32.0 31.0) (next-position (vec2 32.0 32.0) 'fall '() 1.0)) (test-equal "fall in air" (vec2 32.0 31.0) (next-position level (vec2 32.0 32.0) 'fall '() 1.0))
(test-equal "fall on brick" (vec2 32.0 16.0) (next-position level (vec2 32.0 16.0) 'fall '() 1.0))
(test-equal (vec2 31.0 32.0) (next-position (vec2 32.0 32.0) 'go-left '() 1.0)) (test-equal (vec2 31.0 32.0) (next-position level (vec2 32.0 32.0) 'go-left '() 1.0))
(test-equal (vec2 33.0 32.0) (next-position (vec2 32.0 32.0) 'go-right '() 1.0)) (test-equal (vec2 33.0 32.0) (next-position level (vec2 32.0 32.0) 'go-right '() 1.0))
(test-equal (vec2 32.0 32.0) (next-position (vec2 32.0 32.0) 'stationary '() 1.0)) (test-equal (vec2 32.0 32.0) (next-position level (vec2 32.0 32.0) 'stationary '() 1.0))
(test-equal "climb left" (vec2 31.0 32.0) (next-position level (vec2 32.0 32.0) 'climb '(left) 1.0))
(test-equal "climb right" (vec2 33.0 32.0) (next-position level (vec2 32.0 32.0) 'climb '(right) 1.0))
(test-equal "climb down" (vec2 32.0 31.0) (next-position level (vec2 32.0 32.0) 'climb '(down) 1.0))
(test-equal "climb up" (vec2 32.0 33.0) (next-position level (vec2 32.0 32.0) 'climb '(up) 1.0))
(test-equal (vec2 31.0 32.0) (next-position (vec2 32.0 32.0) 'climb '(left) 1.0)) (test-equal "snap to grid on collision with hard scenery"
(test-equal (vec2 33.0 32.0) (next-position (vec2 32.0 32.0) 'climb '(right) 1.0)) (vec2 32.0 16.0)
(test-equal (vec2 32.0 31.0) (next-position (vec2 32.0 32.0) 'climb '(down) 1.0))
(test-equal (vec2 32.0 33.0) (next-position (vec2 32.0 32.0) 'climb '(up) 1.0))
(test-equal
(vec2 32.0 16.0)
(runner-position (runner-position
(runner-update (runner-update
(runner-with-state (runner-with-state

View file

@ -35,6 +35,8 @@
((wall) 3709) ((wall) 3709)
((ladder) 3350) ((ladder) 3350)
((goal) 3404) ((goal) 3404)
((hero) 3800) ;; render empty tile for hero start location
((other) 3800) ;; render empty tile for enemy start location
;; render visual reminder of unknown tile ;; render visual reminder of unknown tile
(else 3326))) (else 3326)))

57
game/render/other.scm Normal file
View file

@ -0,0 +1,57 @@
(define-module (game render other)
#:use-module (game model other)
#:use-module (chickadee)
#:use-module (chickadee math vector)
#:use-module (chickadee graphics sprite)
#:use-module (chickadee graphics texture)
#:export (render-other
render-other-load))
(define other-atlas #f)
(define (render-other-load)
(set! other-atlas (split-texture (load-image "assets/images/simples_pimples.png") 16 16)))
;; start index of the walk animation
(define other-walking-offset 3926)
(define other-falling-offset 3930)
(define other-climbing-offset 3929)
(define (other-sprite-walking other)
(let* ((x (other-x other))
(animation-frame (remainder x 3))
(other-index (+ other-walking-offset animation-frame)))
(texture-atlas-ref other-atlas other-index)))
(define (other-sprite-stationary _other)
(texture-atlas-ref other-atlas other-walking-offset))
(define (other-sprite-falling other)
(texture-atlas-ref other-atlas other-climbing-offset))
(define (other-sprite-climbing other)
(texture-atlas-ref other-atlas other-climbing-offset))
(define (render-other other)
(case (other-state other)
((stationary) (draw-sprite
(other-sprite-stationary other)
(vec2+ (other-position other) (vec2 -0.0 1.0))))
((fall) (draw-sprite
(other-sprite-falling other)
(vec2+ (other-position other) (vec2 -0.0 1.0))))
((climb) (draw-sprite
(other-sprite-climbing other)
(vec2+ (other-position other) (vec2 -0.0 1.0))))
((go-left) (draw-sprite
(other-sprite-walking other)
(vec2+ (other-position other) (vec2 0.0 1.0))
#:scale (vec2 -1.0 1.0)
))
((go-right) (draw-sprite
(other-sprite-walking other)
(vec2+ (other-position other) (vec2 -0.0 1.0))))
)
)