basic movement of hero is kind of working.

game/main.scm

@@ -1,4 +1,5 @@
 (define-module (game main)
+  #:use-module (ice-9 pretty-print)
   #:use-module (game model level)
   #:use-module (game model hero)
   #:use-module (game render level)
@@ -30,12 +31,9 @@
 
 (define (update dt)
   (poll-coop-repl-server repl)
-  (set! hero 
-    (hero-with-x 
-     hero 
-     (floor-remainder 
-      (+  (hero-x hero) (* 50.0 dt)) 
-      608.0))))
+  (set! hero (hero-update hero level inputs dt))
+  (pretty-print hero)
+  )
 
 (define (draw _alpha)
   (render-level-draw level)
@@ -48,17 +46,20 @@
       (cons item set)))
 
 
-(define (key-press key)
+(define (key-press key _modifiers _repeat?)
+  (pretty-print (list 'press key inputs))
   (set! inputs
     (cond ((eq? key 'left) (set-add inputs 'left))
           ((eq? key 'right) (set-add inputs 'right))
           ((eq? key 'up) (set-add inputs 'up))
           ((eq? key 'down) (set-add inputs 'down ))
           ((eq? key 'space) (set-add inputs 'dig ))
-          (else inputs))))
+          (else inputs)))
+  )
 
 
-(define (key-release key)
+(define (key-release key _modifiers)
+  (pretty-print (list 'release key inputs))
   (set! inputs
     (cond ((eq? key 'left) (delete 'left inputs))
           ((eq? key 'right) (delete 'right inputs))
@@ -73,8 +74,8 @@
    #:load (lambda () (load))
    #:update (lambda (dt) (update dt))
    #:draw (lambda (alpha) (draw alpha))
-   ;; #:key-press (lambda (key) (key-press key))
-   ;; #:key-release (lambda (key) (key-release key))
+   #:key-press (lambda (key modifiers repeat?) (key-press key modifiers repeat?))
+   #:key-release (lambda (key modifiers) (key-release key modifiers))
    ))
 
 

game/model/hero.scm

@@ -1,9 +1,12 @@
 ;; Game state and logic for the hero entity
 (define-module (game model hero)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-64)
   #:use-module (chickadee math vector)
+  #:use-module (game util pipe)
   #:use-module (game model level)
   #:export (hero-load
             hero-state 
@@ -11,6 +14,7 @@
             hero-position hero-with-position
             hero-x hero-with-x
             hero-y hero-with-y
+            hero-update
             ))
 
 
@@ -22,7 +26,7 @@
   (bloat hero-bloat hero-with-bloat)                    ;; 0.0 to 2.0, how much the hero is inflated
   )
 
-(define default-state 'stationary)
+(define default-state 'falling)
 (define default-bloat 1.0)
 
 (define (hero-load level)
@@ -43,12 +47,66 @@
 (define (hero-with-y hero y)
   (hero-with-position hero (vec2 (hero-x hero) y)))
 
+
+;; return next state of hero 
+;; @returns 'go-left 'go-right 'climb 'fall 'stationary
+(define (next-state hero level inputs)
+  (let* ((position (hero-position hero))
+         (state (hero-state hero))
+         (tile-below (level-tile-at level (vec2 (hero-x hero) (1- (hero-y hero))))))
+    (cond
+     ((equal? (level-tile-at level position) 'ladder) 'climb)
+     ((> (floor-remainder (hero-y hero) level-cell-size) 0) 'falling)
+     ((equal? tile-below 'empty) 'falling)
+     (else (cond
+            ((member 'left inputs) 'go-left)
+            ((member 'right inputs) 'go-right)
+            (else 'stationary))))))
+
+(define (input->movement input distance)
+  (case input
+    ((left) (vec2 (- distance) 0))
+    ((right) (vec2 distance 0))
+    ((up) (vec2 0 distance))
+    ((down) (vec2 0 (- distance)))
+    (else (vec2 0 0))))
+
+
+(define (next-position position state inputs distance)
+  (case state
+    ((falling) (vec2- position (vec2 0 distance)))
+    ((climb) (vec2+ position (input->movement (car inputs) distance)))
+    ((go-left) (vec2- position (vec2 distance 0)))
+    ((go-right) (vec2+ position (vec2 distance 0)))
+    ((stationary) position)
+    ((ladder) (fold (lambda (input movement)
+                      (vec2+ movement (input->movement input distance)))
+                    position
+                    inputs))
+    (else position)
+    ))
+
 (define speed 50.0)
 
-;; Tests
-[test-begin "hero model"]
+(define (hero-update hero level inputs dt)
+  (let* ((state (next-state hero level inputs))
+         (distance (* dt speed))
+         (position (next-position (hero-position hero) state inputs distance))
+         (tile (level-tile-at level position))
+         )
+    (hero-with-state 
+     (if (member tile '(empty ladder other))
+         (hero-with-position hero position)
+         (hero-with-position hero (vec2 (hero-x hero) (hero-y hero))) ;; round position
+         )
+     state)))
 
-(let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW...W\nWWWWW\n"))
+
+
+;; Tests
+[test-begin "hero-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))
@@ -66,6 +124,43 @@
   (test-equal 16 (hero-x (hero-with-position hero (vec2 16.34 20.78))))
   (test-equal 20 (hero-y (hero-with-position hero (vec2 16.34 20.78))))
   
+  (test-equal 'falling (next-state hero level '()))
+  (let ((hero (hero-with-position hero (vec2 16 16))))
+    (test-equal 'stationary (next-state hero level '()))
+    (test-equal 'go-left (next-state hero level '(left)))
+    (test-equal 'go-right (next-state hero level '(right))))
+  (let ((hero (hero-with-position hero (vec2 48 32))))
+    (test-equal 'stationary (next-state hero level '())))
+  (let ((hero (hero-with-position hero (vec2 48 31))))
+    (test-equal 'climb (next-state hero level '())))
+  (let ((hero (hero-with-position hero (vec2 32 31))))
+    (test-equal 'falling (next-state hero level '())))
+  
+  (test-equal (vec2 32.0 31.0) (next-position (vec2 32.0 32.0) 'falling '() 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 (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) 
+    (hero-position
+     (hero-update
+      (hero-with-state 
+       (hero-with-position hero (vec2 32 16.3)) 
+       'falling)
+      level
+      '()
+      0.017
+      )
+     ))
   )
 
-(test-end "hero model")
+(test-end "hero-model")

game/model/level.scm

@@ -16,6 +16,7 @@
             level-parse
             level-tile-at
             level-find-hero
+            level-cell-size
             ))
 
 (define-record-type <level>
@@ -73,13 +74,15 @@
   (let ((index (+ (* row (level-width level)) col)))
     (vector-ref (level-tiles level) index)))
 
-(define cell-size 16)
+(define level-cell-size 16)
 
 (define (coord->cell coord)
-  (inexact->exact (floor (/ coord cell-size))))
+  (inexact->exact (floor (/ coord level-cell-size))))
 
-(define (level-tile-at level x y )
-  (level-tile-at-row-col level (coord->cell y) (coord->cell x)))
+(define (level-tile-at level position )
+  (let ((x (vec2-x position))
+        (y (vec2-y position)))
+    (level-tile-at-row-col level (coord->cell y) (coord->cell x))))
 
 (define (gen-coords a b)
   (append-map
@@ -93,7 +96,7 @@
 
 (define (level-find-tile level tile)
   (map 
-   (lambda (rc) (vec2 (* cell-size (cadr rc)) (* cell-size (car rc))))
+   (lambda (rc) (vec2 (* level-cell-size (cadr rc)) (* level-cell-size (car rc))))
    (filter
     (lambda (rc)
       (equal? 

game/render/hero.scm

@@ -17,17 +17,47 @@
   (set! hero-atlas (split-texture hero-texture 32 32))) 
 
 ;; start index of the walk animation
-(define hero-walk-offset 56)
+(define hero-walking-offset 56)
+(define hero-falling-offset 32)
+(define hero-climbing-offset 40)
 
-(define (hero-sprite hero)
-  (let* ((x (inexact->exact (floor (vec2-x (hero-position hero)))))
+(define (hero-sprite-walking hero)
+  (let* ((x (hero-x hero))
          (animation-frame (remainder x 8))
-         (hero-index (+ hero-walk-offset animation-frame)))
+         (hero-index (+ hero-walking-offset animation-frame)))
+    (texture-atlas-ref hero-atlas hero-index)))
+
+(define (hero-sprite-stationary _hero)
+  (texture-atlas-ref hero-atlas 56))
+
+
+(define (hero-sprite-falling hero)
+  (let* ((y (hero-y hero))
+         (animation-frame (remainder y 8))
+         (hero-index (+ hero-falling-offset animation-frame)))
+    (texture-atlas-ref hero-atlas hero-index)))
+
+(define (hero-sprite-climbing hero)
+  (let* ((y (hero-y hero))
+         (animation-frame (remainder y 8))
+         (hero-index (+ hero-climbing-offset animation-frame)))
     (texture-atlas-ref hero-atlas hero-index)))
 
 (define (render-hero hero)
-  (draw-sprite
-   (hero-sprite hero)
-   (vec2+ 
-    (hero-position hero) 
-    (vec2 -9.0 0.0))))
+  (case (hero-state hero)
+    ((stationary) (draw-sprite
+                   (hero-sprite-stationary hero)
+                   (vec2+ (hero-position hero) (vec2 -9.0 1.0))))
+    ((falling) (draw-sprite
+                (hero-sprite-falling hero)
+                (vec2+ (hero-position hero) (vec2 -9.0 1.0))))
+    ((go-left) (draw-sprite
+                (hero-sprite-walking hero)
+                (vec2+ (hero-position hero) (vec2 23.0 1.0))
+                #:scale (vec2 -1.0 1.0)
+                ))
+    ((go-right) (draw-sprite
+                 (hero-sprite-walking hero)
+                 (vec2+ (hero-position hero) (vec2 -9.0 1.0))))
+    )
+  )

game/render/level.scm

@@ -47,15 +47,12 @@
      (for-each
       (lambda (column)
         (let* 
-            ((x (* 16 column))
-             (y (* 16 row))
-             (tile (level-tile-at level x y))
+            ((position (vec2 (* 16 column) (* 16 row)))
+             (tile (level-tile-at level position))
              (texture-region (texture-atlas-ref tile-atlas (level-tile-index tile))))
-          (display (format #f "tile ~a at ~a ~a~%" (level-tile-index tile) row column))
-          (sprite-batch-add! sprite-batch (vec2 x y) 
+          (sprite-batch-add! sprite-batch position 
                              #:texture-region texture-region)))
       (iota (level-width level) 0)))
-   
    (iota (level-height level) 0)))
 
 ;; render the level tiles

game/util/pipe.scm

@@ -0,0 +1,28 @@
+(define-module (game util pipe)
+  #:export (-> ->>)
+  #:version (0 1 0))
+
+;; Thread first macro.
+;; The first s-expression will be inserted as the first argument of the next s-expesssion.
+;; Example: (-> 100 (/ 10) (/ 5)) becomes (/ (/ 100 10) 5)
+(define-syntax ->
+  (syntax-rules ()
+    ((_) #f)
+    ((_ x) x)
+    ((_ x (f . (f-rest ...))) (f x f-rest ...))
+    ((_ x f) (f x))
+    ((_ x (f . (f-rest ...)) rest ...) (-> (f x f-rest ...) rest ...))
+    ((_ x f rest ...) (-> (f x) rest ...))
+    ))
+
+;; Thread last macro.
+;; The first s-expression will be inserted as the last argument of the next s-expesssion.
+;; Example: (-> 100 (/ 10) (/ 5)) becomes (/ 5 (/ 10 100))
+(define-syntax ->>
+  (syntax-rules ()
+    ((_) #f)
+    ((_ x) x)
+    ((_ x (f ...)) (f ... x))
+    ((_ x f) `(f x))
+    ((_ x (f ...) rest ...) (->> (f ... x) rest ...))
+    ((_ x f rest ...) (->> (f x) rest ...))))