From 8332dca1fc6d86552aadd654df1b1691c83da024 Mon Sep 17 00:00:00 2001 From: Peter Tillemans Date: Wed, 22 May 2024 12:53:01 +0200 Subject: [PATCH] render others and integrate model in main --- assets/levels/level-1.map | 4 +- game/main.scm | 7 ++++ game/model/hero.scm | 8 ++-- game/model/level.scm | 7 +++- game/model/other.scm | 80 +++++++++++++++++++-------------------- game/model/runner.scm | 65 +++++++++++++++++-------------- game/render/level.scm | 2 + game/render/other.scm | 57 ++++++++++++++++++++++++++++ 8 files changed, 153 insertions(+), 77 deletions(-) create mode 100644 game/render/other.scm diff --git a/assets/levels/level-1.map b/assets/levels/level-1.map index 24714bc..864ae02 100644 --- a/assets/levels/level-1.map +++ b/assets/levels/level-1.map @@ -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 diff --git a/game/main.scm b/game/main.scm index e7683db..8ac657b 100644 --- a/game/main.scm +++ b/game/main.scm @@ -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) diff --git a/game/model/hero.scm b/game/model/hero.scm index 2d49f16..e68bb14 100644 --- a/game/model/hero.scm +++ b/game/model/hero.scm @@ -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-end "hero-model")) + (test-equal default-bloat (hero-bloat hero))) + +(test-end "hero-model") diff --git a/game/model/level.scm b/game/model/level.scm index 19d14f8..55d0945 100644 --- a/game/model/level.scm +++ b/game/model/level.scm @@ -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 @@ -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) diff --git a/game/model/other.scm b/game/model/other.scm index 2d49f16..ba849b1 100644 --- a/game/model/other.scm +++ b/game/model/other.scm @@ -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 - (%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 + (%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)) - - (test-equal 1.5 (hero-bloat (hero-with-bloat hero 1.5))) - (test-equal default-bloat (hero-bloat hero)) - - (test-end "hero-model")) +(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-end "other-model") diff --git a/game/model/runner.scm b/game/model/runner.scm index f2a3828..5bf3c71 100644 --- a/game/model/runner.scm +++ b/game/model/runner.scm @@ -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,21 +137,20 @@ (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 - (vec2 32.0 16.0) + (test-equal "snap to grid on collision with hard scenery" + (vec2 32.0 16.0) (runner-position (runner-update (runner-with-state diff --git a/game/render/level.scm b/game/render/level.scm index ebb2b7f..5783714 100644 --- a/game/render/level.scm +++ b/game/render/level.scm @@ -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))) diff --git a/game/render/other.scm b/game/render/other.scm new file mode 100644 index 0000000..6551fec --- /dev/null +++ b/game/render/other.scm @@ -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)))) + ) + )