pti/bloatrunner
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

render others and integrate model in main

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

4
assets/levels/level-1.map
View file

@ -5,7 +5,7 @@
WWWWGWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW
W H W
W O H O W
W H W
W H H W
W O BBBBBBBBBBBBBBBBBBBBBBBBBBHB O 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 H W -
W P BHBBBBBBB W
W H W
W H W

7
game/main.scm
View file

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

6
game/model/hero.scm
View file

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

7
game/model/level.scm
View file

@ -15,8 +15,10 @@
level-parse-file
level-parse
level-tile-at
level-find-hero
level-cell-size
level-find-hero
level-find-others
level-tile-blocked?
))
(define-record-type <level>
@ -84,6 +86,9 @@
(y (vec2-y position)))
(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)
(append-map
(lambda (r)

76
game/model/other.scm
View file

@ -1,5 +1,5 @@
;; Game state and logic for the hero entity
(define-module (game model hero)
;; 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)
@ -9,65 +9,63 @@
#:use-module (game util pipe)
#:use-module (game model level)
#:use-module (game model runner)
#:export (hero-load
hero-state
hero-bloat
hero-position
hero-x
hero-y
hero-update
#:export (other-load-others
other-state
other-bloat
other-position
other-x
other-y
other-update
))
(define-immutable-record-type <hero>
(%make-hero runner bloat)
hero?
(runner hero-runner hero-with-runner)
(bloat hero-bloat hero-with-bloat) ;; 0.0 to 2.0, how much the hero is inflated
(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 (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-bloat)))
(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 (hero-x hero)
(define (other-x other)
"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"
(runner-y (hero-runner hero))
(runner-y (other-runner other))
)
(define (hero-state hero)
"return the current state of the hero"
(runner-state (hero-runner hero)))
(define (other-state other)
"return the current state of the other"
(runner-state (other-runner other)))
(define (hero-position hero)
"return the current position of the hero"
(runner-position (hero-runner hero)))
(define (other-position other)
"return the current position of the other"
(runner-position (other-runner other)))
(define (hero-update hero level inputs dt)
(hero-with-runner hero (runner-update (hero-runner hero) level inputs dt)))
(define (other-update other level dt)
(other-with-runner other (runner-update (other-runner other) level '() dt)))
;; Tests
[test-begin "hero-model"]
(test-begin "other-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-bloat (hero-bloat hero))
(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))
)
(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")

63
game/model/runner.scm
View file

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

2
game/render/level.scm
View file

@ -35,6 +35,8 @@
((wall) 3709)
((ladder) 3350)
((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
(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))))
)
)