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

add hero initialisation

Browse source
This commit is contained in:
Peter Tillemans 2024-05-21 12:48:43 +02:00
parent bdd12beff5
commit 8dcf58661b
7 changed files with 91 additions and 84 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -4,9 +4,9 @@
----|----|----|----|----|----|----|----|
WWWWGWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW
W H W
W E H E W
W O H O W
W H W
W E BBBBBBBBBBBBBBBBBBBBBBBBBBBB E W -
W O BBBBBBBBBBBBBBBBBBBBBBBBBBBB O W -
W H W
W H W
W H W

6
bundle.scm
View file

@ -1,4 +1,4 @@
'((asset-directories . ("assets/images"))
(bundle-name . "chickadee-game-template-0.1.0-x86_64")
'((asset-directories . ("assets/images" "assets/levels"))
(bundle-name . "bloatrunner-0.1.0-x86_64")
(code . "game/main.scm")
(launcher-name . "chickadee-game-template"))
(launcher-name . "bloatrunner"))

11
game/main.scm
View file

@ -25,14 +25,19 @@
(render-hero-load)
(set! level (level-parse-file "assets/levels/level-1.map"))
(render-level-set! level)
(set! hero (hero-load))
(set! hero (hero-load level))
(set! repl (spawn-coop-repl-server)))
(define (update dt)
(poll-coop-repl-server repl)
(set! hero
(hero-with-x hero
(floor-remainder (+ (hero-x hero) (* 50.0 dt)) 608.0))))
(hero-with-position
hero
(set-vec2-x!
(hero-position hero)
(floor-remainder
(+ (vec2-x (hero-position hero))
(* 50.0 dt)) 608.0)))))
(define (draw _alpha)
(render-level-draw level)

40
game/model/hero.scm
View file

@ -4,53 +4,47 @@
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-64)
#:use-module (chickadee math vector)
#:use-module (game model level)
#:export (hero-load
hero-x hero-with-x
hero-y hero-with-y
hero-state hero-with-state
hero-bloat hero-with-bloat
hero-position
hero-position hero-with-position
))
(define-immutable-record-type <hero>
(%make-hero x y state bloat)
(%make-hero position state bloat)
hero?
(x hero-x hero-with-x)
(y hero-y hero-with-y)
(position hero-position hero-with-position)
(state hero-state hero-with-state) ;; 'go-left 'go-right 'climb 'fall 'stationary
(bloat hero-bloat hero-with-bloat) ;; 0.0 to 2.0, how much the hero is inflated
)
(define default-x 320)
(define default-y 32)
(define default-state 'stationary)
(define default-bloat 1.0)
(define (hero-load)
(%make-hero default-x default-y default-state default-bloat))
(define (hero-position hero)
(vec2 (hero-x hero) (hero-y hero)))
(define (hero-load level)
(let ((initial-position (level-find-hero level)))
(%make-hero initial-position default-state default-bloat)))
;; Tests
[test-begin "hero model"]
(test-assert (hero? (hero-load)))
(test-equal default-x (hero-x (hero-load)))
(test-equal default-y (hero-y (hero-load)))
(test-equal default-state (hero-state (hero-load)))
(test-equal default-bloat (hero-bloat (hero-load)))
(let ((hero (hero-load)))
(test-equal 10 (hero-x (hero-with-x hero 10)))
(test-equal default-x (hero-x hero))
(test-equal 20 (hero-y (hero-with-y hero 20)))
(test-equal default-y (hero-y hero))
(let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW...W\nWWWWW\n"))
(hero (hero-load level))
(default-position (level-find-hero level)))
(test-assert (hero? hero))
(test-equal default-position (hero-position hero))
(test-equal default-state (hero-state hero))
(test-equal default-bloat (hero-bloat hero))
(test-equal (vec2 10 20) (hero-position (hero-with-position hero (vec2 10 20))))
(test-equal default-position (hero-position hero))
(test-equal 'go-left (hero-state (hero-with-state hero 'go-left)))
(test-equal default-state (hero-state hero))
(test-equal 1.5 (hero-bloat (hero-with-bloat hero 1.5)))
(test-equal default-bloat (hero-bloat hero)))
(test-equal (vec2 default-x default-y) (hero-position (hero-load)))
(test-end "hero model")

106
game/model/level.scm
View file

@ -10,20 +10,22 @@
level-height
level-tiles
level-entities
level-player
level-hero
level-goal
level-parse-file
level-parse
level-tile-at
level-find-hero
))
(define-record-type <level>
(%make-level width height tiles goal player entities)
(%make-level width height tiles goal hero entities)
level?
(width level-width)
(height level-height)
(tiles level-tiles)
(goal level-goal)
(player level-player)
(hero level-hero)
(entities level-entities))
(define (parse-tile c)
@ -31,8 +33,8 @@
((#\W) 'wall)
((#\B) 'brick)
((#\H) 'ladder)
((#\P) 'player)
((#\E) 'enemy)
((#\P) 'hero)
((#\O) 'other)
((#\G) 'goal)
(else 'empty)))
@ -80,54 +82,56 @@
(level-tile-at-row-col level (coord->cell y) (coord->cell x)))
(define (gen-coords a b)
(for ((row (iota a)))
(for ((col (iota b)))
(list row col))
)
(append-map
(lambda (r)
(map
(lambda (c)
(list r c))
(iota b)))
(iota a))
)
(define (level-find-tile level tile)
(let loop ((row 0))
(if (= row (level-height level))
#f
(let loop2 ((col 0))
(if (= col (level-width level))
(loop (+ row 1))
(if (eq? (level-tile-at-row-col level row col) 'player)
(vec2 (* col cell-size) (* row cell-size))
(loop2 (+ col 1))))))))
(define (level-find-player level)
(let loop ((row 0))
(if (= row (level-height level))
#f
(let loop2 ((col 0))
(if (= col (level-width level))
(loop (+ row 1))
(if (eq? (level-tile-at-row-col level row col) 'player)
(vec2 (* col cell-size) (* row cell-size))
(loop2 (+ col 1))))))))
(map
(lambda (rc) (vec2 (* cell-size (cadr rc)) (* cell-size (car rc))))
(filter
(lambda (rc)
(equal?
(level-tile-at-row-col level (car rc) (cadr rc))
tile))
(gen-coords (level-height level) (level-width level)))))
(define (level-find-hero level)
(car (level-find-tile level 'hero)))
(define (level-find-goal level)
(car (level-find-tile level 'goal)))
(define (level-find-others level)
(level-find-tile level 'other))
;; Tests
(test-begin "level")
(test-assert (level? (level-parse "WWWWW\nWP GW\nWWWWW\n")))
(test-equal (level-width (level-parse "WWWWW\nWP GW\nWWWWW\n")) 5)
(test-equal (level-height (level-parse "WWWWW\nWP GW\nWWWWW\n")) 3)
(test-equal (level-tiles (level-parse "W")) #(wall))
(test-equal
(level-tiles (level-parse "WWWWW\nWP GW\nWWWWW\n"))
#(wall wall wall wall wall wall player empty goal wall wall wall wall wall wall))
(test-equal
(level-tiles (level-parse "--- ignore this line\nWWWWW\nWP GW - must be ignored\nWWWWW\n"))
#(wall wall wall wall wall wall player empty goal wall wall wall wall wall wall))
(test-equal (content->lines "WWWWW\nWP GW\nWWWWW\n") '("WWWWW" "WP GW" "WWWWW"))
(let ((level (level-parse "WWWWW\nWP GW\nWWWWW\n")))
(test-assert (level? level))
(test-equal (level-width level) 5)
(test-equal (level-height level) 3)
(test-equal
(level-tiles level)
#(wall wall wall wall wall wall hero empty goal wall wall wall wall wall wall)))
(test-equal "check if comments are ignored"
(level-tiles (level-parse "--- ignore this line\nWWWWW\nWP GW - must be ignored\nWWWWW\n"))
#(wall wall wall wall wall wall hero empty goal wall wall wall wall wall wall))
(test-equal (parse-tile #\W) 'wall)
(test-equal (parse-tile #\B) 'brick)
(test-equal (parse-tile #\H) 'ladder)
(test-equal (parse-tile #\P) 'player)
(test-equal (parse-tile #\E) 'enemy)
(test-equal (parse-tile #\P) 'hero)
(test-equal (parse-tile #\O) 'other)
(test-equal (parse-tile #\G) 'goal)
(test-equal (parse-tile #\space) 'empty)
@ -136,22 +140,26 @@
(test-equal
(level-tile-at-row-col (level-parse "WWWWW\nWP GW\nWWWWW\n") 1 1)
'player)
'hero)
(test-equal
(level-tile-at-row-col (level-parse "WWWWW\nWP GW\nWWWWW\n") 1 3)
'goal)
(test-equal (gen-coords 2 3) '((0 0) (0 1) (0 2) (1 0) (1 1) (1 2)))
(let ((level (level-parse "WWWWW\nWO OW\nWP GW\nWWWWW\n")))
(test-equal
(level-find-player (level-parse "WWWWW\nWP GW\nWWWWW\n"))
(vec2 16 16))
(vec2 16 16)
(level-find-hero level))
(test-equal
(level-find-goal (level-parse "WWWWW\nWP GW\nWWWWW\n"))
(vec2 48 16))
(vec2 48 16)
(level-find-goal level))
(test-equal
(level-find-others (level-parse "WWWWW\nWE EW\nWWWWW\n"))
(list (vec 16 16) (vec2 48 16)))
(list (vec2 16 32) (vec2 48 32))
(level-find-others level))
)
(test-end "level")

1
game/render/hero.scm
View file

@ -12,7 +12,6 @@
(define hero-texture #f)
(define hero-atlas #f)
(define (render-hero-load)
(set! hero-texture (load-image "assets/images/lr_penguin2.png"))
(set! hero-atlas (split-texture hero-texture 32 32)))

1
game/render/level.scm
View file

@ -51,6 +51,7 @@
(y (* 16 row))
(tile (level-tile-at level x y))
(texture-region (texture-atlas-ref tile-atlas (level-tile-index tile))))
(format #f "tile ~a at ~a ~a~%" (level-tile-index tile) x y)
(sprite-batch-add! sprite-batch (vec2 x y)
#:texture-region texture-region)))
(iota (level-width level) 0)))