render others and integrate model in main

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

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)

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-equal default-bloat (hero-bloat hero)))
 
-  (test-end "hero-model"))
+(test-end "hero-model")
 

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 <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)

game/model/other.scm

@@ -1,5 +1,5 @@
-;; Game state and logic for the hero entity
+;; Game state and logic for the other entity
-(define-module (game model hero)
+(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
+  #:export (other-load-others
-            hero-state 
+            other-state 
-            hero-bloat
+            other-bloat
-            hero-position
+            other-position
-            hero-x 
+            other-x 
-            hero-y
+            other-y
-            hero-update
+            other-update
             ))
 
 
-(define-immutable-record-type <hero>
+(define-immutable-record-type <other>
-  (%make-hero runner bloat)
+  (%make-other runner)
-  hero?
+  other?
-  (runner hero-runner hero-with-runner)
+  (runner other-runner other-with-runner)
-  (bloat hero-bloat hero-with-bloat)                    ;; 0.0 to 2.0, how much the hero is inflated
   )
 
 (define default-state 'fall)
 (define default-bloat 1.0)
 
-(define (hero-load level)
+(define (other-load-others level)
-  "Create a hero at the position in the level map"
+  "Create a other at the position in the level map"
-  (let ((runner (runner-load (level-find-hero level))))
+  (map 
-    (%make-hero runner default-bloat)))
+   (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)
+(define (other-state other)
-  "return the current state of the hero"
+  "return the current state of the other"
-  (runner-state (hero-runner hero)))
+  (runner-state (other-runner other)))
 
-(define (hero-position hero)
+(define (other-position other)
-  "return the current position of the hero"
+  "return the current position of the other"
-  (runner-position (hero-runner hero)))
+  (runner-position (other-runner other)))
 
 
-(define (hero-update hero level inputs dt)
+(define (other-update other level dt)
-  (hero-with-runner hero (runner-update (hero-runner hero) level inputs 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"))
+(let* ((level (level-parse "WWWWW\nW...W\nWO.OW\nW..HW\nWWWWW\n"))
-       (hero (hero-load level))
+       (others (other-load-others level)))
-       (default-position (level-find-hero level)))
+  (test-assert (other? (car others)))
-  (test-assert (hero? hero))
+  (test-equal 2 (length others))
-  (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-end "other-model")
 

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)))
+    ((fall) (safe-move level position (vec2 0 (- distance))))
-    ((go-left) (vec2- position (vec2 distance 0)))
+    ((go-left) (safe-move level position (vec2 (- distance) 0)))
-    ((go-right) (vec2+ position (vec2 distance 0)))
+    ((go-right) (safe-move level position (vec2 distance 0)))
     ((stationary) position)
-    ((climb) (fold (lambda (input movement)
+    ((climb) (fold (lambda (input pos) 
-                     (vec2+ movement (input->movement input distance)))
+                     (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))
+         (position (next-position level (runner-position runner) (runner-state runner) inputs distance))
-         (tile (level-tile-at level position))
          )
-    (runner-with-state 
+    (-> runner
-     (if (member tile '(empty ladder other))
+        (runner-with-state state)
-         (runner-with-position runner position)
+        (runner-with-position position))))
-         (runner-with-position runner (vec2 (runner-x runner) (runner-y runner))) ;; round position
-         )
-     state)))
 
 
 
 ;; 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 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 (vec2 32.0 32.0) 'go-right '() 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 (vec2 32.0 32.0) 'stationary '() 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 "snap to grid on collision with hard scenery"
-  (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) 
     (runner-position
      (runner-update

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)))
 

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))))
+    )
+  )