From 8dcf58661bfe2968d10a2ea4149d4c59ad3d8230 Mon Sep 17 00:00:00 2001 From: Peter Tillemans Date: Tue, 21 May 2024 12:48:43 +0200 Subject: [PATCH] add hero initialisation --- assets/levels/level-1.map | 4 +- bundle.scm | 6 +- game/main.scm | 11 +++- game/model/hero.scm | 40 ++++++-------- game/model/level.scm | 112 ++++++++++++++++++++------------------ game/render/hero.scm | 1 - game/render/level.scm | 1 + 7 files changed, 91 insertions(+), 84 deletions(-) diff --git a/assets/levels/level-1.map b/assets/levels/level-1.map index b148034..3b561de 100644 --- a/assets/levels/level-1.map +++ b/assets/levels/level-1.map @@ -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 diff --git a/bundle.scm b/bundle.scm index 59d3b4a..0ad74b3 100644 --- a/bundle.scm +++ b/bundle.scm @@ -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")) diff --git a/game/main.scm b/game/main.scm index 4fc9f39..0149b59 100644 --- a/game/main.scm +++ b/game/main.scm @@ -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) diff --git a/game/model/hero.scm b/game/model/hero.scm index 07fb88a..61f8834 100644 --- a/game/model/hero.scm +++ b/game/model/hero.scm @@ -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 - (%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") diff --git a/game/model/level.scm b/game/model/level.scm index 84ccd3b..7a893c3 100644 --- a/game/model/level.scm +++ b/game/model/level.scm @@ -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 - (%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 - (level-find-player (level-parse "WWWWW\nWP GW\nWWWWW\n")) - (vec2 16 16)) +(test-equal (gen-coords 2 3) '((0 0) (0 1) (0 2) (1 0) (1 1) (1 2))) -(test-equal - (level-find-goal (level-parse "WWWWW\nWP GW\nWWWWW\n")) - (vec2 48 16)) +(let ((level (level-parse "WWWWW\nWO OW\nWP GW\nWWWWW\n"))) + (test-equal + (vec2 16 16) + (level-find-hero level)) -(test-equal - (level-find-others (level-parse "WWWWW\nWE EW\nWWWWW\n")) - (list (vec 16 16) (vec2 48 16))) + (test-equal + (vec2 48 16) + (level-find-goal level)) + + (test-equal + (list (vec2 16 32) (vec2 48 32)) + (level-find-others level)) + ) (test-end "level") diff --git a/game/render/hero.scm b/game/render/hero.scm index ca9d6b8..c08f56c 100644 --- a/game/render/hero.scm +++ b/game/render/hero.scm @@ -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))) diff --git a/game/render/level.scm b/game/render/level.scm index bdd7a30..8650048 100644 --- a/game/render/level.scm +++ b/game/render/level.scm @@ -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)))