refactored asset loading

This commit is contained in:
Peter Tillemans 2024-05-25 15:19:30 +02:00
parent c4df134f53
commit 2589b236d4
6 changed files with 67 additions and 32 deletions

View file

@ -69,7 +69,7 @@
(wrap-program (string-append out "/bin/bloatrunner")
`("GUILE_LOAD_PATH" ":" prefix (,mods))
`("GUILE_LOAD_COMPILED_PATH" ":" prefix (,objs))
`("ASSET_DIR" ":" prefix (,(string-append out "/share/bloatrunner")))
`("ASSET_DIR" ":" prefix (,(string-append out "/share/bloatrunner/assets")))
)))))
))
(native-inputs

View file

@ -35,13 +35,15 @@
(define state 'running)
(define (load)
"Load the game initial game state."
(assets-load)
(render-level-load)
(set! levels (assets-map-levels level-parse-file))
(set! levels (assets-map-levels level-parse))
(load-level)
(set! repl (spawn-coop-repl-server)))
(define (load-level)
"Load the next level and reset game state."
(set! level (car levels))
(set! levels (cdr levels))
(render-level-set! level)
@ -51,6 +53,7 @@
(set! foods (food-load level)))
(define (update dt)
"Update the game state."
(poll-coop-repl-server repl)
(set! hero (hero-update hero level inputs keys (food-total-calories-eaten foods) dt))
(set! others (map (lambda (other) (other-update other level hero others dt)) others))
@ -60,11 +63,11 @@
(set! state 'lost))
(if (level-same-cell? (hero-position hero) (level-find-goal level))
(if (null? levels)
(set! status 'won)
(load-level)))
)
(set! state 'won)
(load-level))))
(define (render-level)
"Render the level and entities for the running state"
(render-level-draw level)
(for-each render-other others)
(render-keys keys (level-find-goal level))
@ -72,17 +75,26 @@
(render-hero hero))
(define (draw _alpha)
"Draw the game screen depending on state"
(case state
((won) (render-victory))
((lost) (render-defeat))
(else (render-level))))
;; Input handling
;; keep a set of buttons which are currently pressed
;;
(define (set-add set item)
(if (member item set)
"Add an item to a list if it is not already present."
(if (member item set)
set
(cons item set)))
(define (key-press key _modifiers _repeat?)
"Handle key press events by adding the input to the inputs set."
(set! inputs
(cond ((eq? key 'left) (set-add inputs 'left))
((eq? key 'right) (set-add inputs 'right))
@ -94,6 +106,7 @@
(define (key-release key _modifiers)
"Handle key release events by removing the input from the inputs set."
(set! inputs
(cond ((eq? key 'left) (delete 'left inputs))
((eq? key 'right) (delete 'right inputs))
@ -103,6 +116,7 @@
(else inputs))))
(define (launch-game args)
"Launch the game with the given arguments."
(run-game
#:window-title "Bloatrunner"
#:load (lambda () (load))

View file

@ -91,7 +91,9 @@
(define (hero-update hero level inputs keys calories-eaten dt)
(let* ((new-runner (runner-update (hero-runner hero) level inputs dt))
(new-runner (if (blocked-by-door? level keys
(new-runner (if (blocked-by-door?
level
keys
(runner-position new-runner)
(hero-bloat hero))
(hero-runner hero)
@ -123,10 +125,13 @@
(let* ((level (level-parse "WWGWW\nW.H.W\nW.P.W\nWWWWW\n"))
(hero (hero-load level))
(goal-position (level-find-goal level)))
(test-assert (blocked-by-door? level '(dummy-key) goal-position))
(test-assert (not (blocked-by-door? level '() goal-position)))
(test-assert (blocked-by-door? level '(dummy-key) (vec2- goal-position (vec2 0 -15))))
(test-assert (not (blocked-by-door? level '(dummy-key) (vec2- goal-position (vec2 0 -16))))))
(test-assert (blocked-by-door? level '(dummy-key) goal-position 1.0))
(test-assert (not (blocked-by-door? level '() goal-position 1.0)))
(test-assert (blocked-by-door? level '(dummy-key) (vec2- goal-position (vec2 0 -15)) 1.0))
(test-assert (not (blocked-by-door? level '(dummy-key) (vec2- goal-position (vec2 0 -16)) 1.0)))
(test-assert (blocked-by-door? level '() goal-position 1.55))
)
(test-end "hero-model")

View file

@ -39,6 +39,7 @@
(entities level-entities))
(define (parse-tile c)
"Parse a character into a tile type"
(case c
((#\W) 'wall)
((#\B) 'brick)
@ -52,6 +53,7 @@
(else 'empty)))
(define (content->lines content)
"Parse a string into a list of lines, ignoring empty lines and comments"
(filter (lambda (line) (not (string-null? line)))
(map
(lambda (line)
@ -62,6 +64,7 @@
(define (parse-lines lines)
"Parse a list of lines into a list of tiles"
(fold append
'()
(map
@ -70,6 +73,7 @@
lines)))
(define (level-parse content)
"Parse a level from a string"
(let* ((lines (content->lines content))
(width (string-length (car lines)))
(height (length lines))
@ -77,20 +81,19 @@
(parse-lines lines))))
(%make-level width height tiles)))
(define (level-parse-file filename)
(level-parse (call-with-input-file filename get-string-all)))
(define (level-tile-at-row-col level row col )
"Get the tile at a given row and column"
(let ((index (+ (* row (level-width level)) col)))
(vector-ref (level-tiles level) index)))
(define level-cell-size 16)
(define (coord->cell coord)
"Convert a screen coordinate to a vector cell index"
(inexact->exact (floor (/ coord level-cell-size))))
(define (level-tile-at level position )
"Get the tile at a given screen position"
(let ((x (vec2-x position))
(y (vec2-y position)))
(level-tile-at-row-col level (coord->cell y) (coord->cell x))))
@ -168,8 +171,8 @@
(test-equal (parse-tile #\F) 'bad-food)
(test-equal (parse-tile #\f) 'good-food)
(test-equal (level-width (level-parse-file "assets/levels/level-001.map")) 40)
(test-equal (level-height (level-parse-file "assets/levels/level-001.map")) 30)
(test-equal (level-width (level-parse (read-level-map "level-001.map"))) 40)
(test-equal (level-height (level-parse (read-level-map "level-001.map"))) 30)
(test-equal
(level-tile-at-row-col (level-parse "WWWWW\nWP GW\nWWWWW\n") 1 1)

View file

@ -3,7 +3,7 @@
#:use-module (ice-9 textual-ports)
#:use-module (chickadee graphics texture)
#:use-module (chickadee graphics color)
#:export (assets-load assets-file-name tile-texture tile-atlas hero-texture hero-atlas assets-map-levels)
#:export (assets-load assets-load-image tile-texture tile-atlas hero-texture hero-atlas assets-map-levels read-level-map)
)
@ -14,11 +14,11 @@
(define hero-atlas #f)
(define (assets-location)
"find the location of the assets directory. The location is specified
by the ASSET_DIR environment variable, or defaults to 'assets' in the
current directory."
(pk "Assets location: "
(if (current-filename)
(string-append (dirname (current-filename)) "/../../assets")
(or (getenv "ASSET_DIR") "." )))
)
(or (getenv "ASSET_DIR") "assets" )))
(define (assets-file-name . names)
"Return the full path of a file in the assets directory. The file is
@ -29,18 +29,31 @@
(define (read-level-map filename)
(call-with-input-file filename get-string-all))
"Read a level map from a file. The map is a list of strings, where each
string is a row of the map. The map is read from the file in the
'levels' directory."
(call-with-input-file (assets-file-name "levels" filename) get-string-all))
(define (level-map? filename )
"Return true if the filename is a level map file. Level map files have
the extension '.map'."
(string-suffix? ".map" filename))
(define (assets-map-levels f)
(map f
(map (lambda (filename)(assets-file-name "levels" filename))
(scandir (assets-file-name "levels")
(lambda (filename) (string-suffix? ".map" filename ))))))
"Apply a function to each level map file in the 'levels' directory. The
function is passed the filename of the level map file."
(map
(compose f read-level-map)
(scandir (assets-file-name "levels") level-map?)))
(define (assets-load-image filename)
"Load an image from a file in the assets directory. The filename is
specified as a list of names, which are joined together. The image is
returned as a texture."
(load-image (assets-file-name "images" filename)))
(define (assets-load)
"Load all the assets for the game."
(set! tile-texture (assets-load-image "simples_pimples.png"))
(set! tile-atlas (split-texture tile-texture 16 16))

View file

@ -5,6 +5,6 @@ abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`"
export GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH"
export GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH"
export PATH="$abs_top_builddir/scripts:$PATH"
export PATH="$abs_top_builddir:$PATH"
exec "$@"