add hero initialisation

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

bundle.scm

@@ -1,4 +1,4 @@
-'((asset-directories . ("assets/images"))
+'((asset-directories . ("assets/images" "assets/levels"))
-  (bundle-name . "chickadee-game-template-0.1.0-x86_64")
+  (bundle-name . "bloatrunner-0.1.0-x86_64")
   (code . "game/main.scm")
-  (launcher-name . "chickadee-game-template"))
+  (launcher-name . "bloatrunner"))

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
+    (hero-with-position 
-                 (floor-remainder (+ (hero-x hero) (* 50.0 dt)) 608.0))))
+     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)

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 <hero>
-  (%make-hero x y state bloat)
+  (%make-hero position state bloat)
   hero?
-  (x hero-x hero-with-x)
+  (position hero-position hero-with-position)
-  (y hero-y hero-with-y)
   (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)
+(define (hero-load level)
-  (%make-hero default-x default-y default-state default-bloat))
+  (let ((initial-position (level-find-hero level)))
-
+    (%make-hero initial-position default-state default-bloat)))
-(define (hero-position hero)
-  (vec2 (hero-x hero) (hero-y hero)))
 
 ;; 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)))
+(let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW...W\nWWWWW\n"))
-  (test-equal 10 (hero-x (hero-with-x hero 10)))
+       (hero (hero-load level))
-  (test-equal default-x (hero-x hero))
+       (default-position (level-find-hero level)))
-  (test-equal 20 (hero-y (hero-with-y hero 20))) 
+  (test-assert (hero? hero))
-  (test-equal default-y (hero-y 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")

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 <level>
-  (%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)
+    ((#\P) 'hero)
-    ((#\E) 'enemy)
+    ((#\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)))
+  (append-map
-    (for ((col (iota b)))
+   (lambda (r)
-      (list row col))
+     (map
-    )
+      (lambda (c)
+        (list r c))
+      (iota b)))
+   (iota a))
   )
 
 (define (level-find-tile level tile)
-  (let loop ((row 0))
+  (map 
-    (if (= row (level-height level))
+   (lambda (rc) (vec2 (* cell-size (cadr rc)) (* cell-size (car rc))))
-        #f
+   (filter
-        (let loop2 ((col 0))
+    (lambda (rc)
-          (if (= col (level-width level))
+      (equal? 
-              (loop (+ row 1))
+       (level-tile-at-row-col level (car rc) (cadr rc)) 
-              (if (eq? (level-tile-at-row-col level row col) 'player)
+       tile))
-                  (vec2 (* col cell-size) (* row cell-size))
+    (gen-coords (level-height level) (level-width level)))))
-                  (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))))))))
 
+(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 #\P) 'hero)
-(test-equal (parse-tile #\E) 'enemy)
+(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 (gen-coords 2 3) '((0 0) (0 1) (0 2) (1 0) (1 1) (1 2)))
+
+(let ((level (level-parse "WWWWW\nWO OW\nWP GW\nWWWWW\n")))
   (test-equal 
-    (level-find-player (level-parse "WWWWW\nWP GW\nWWWWW\n"))
+      (vec2 16 16)
-  (vec2 16 16))
+    (level-find-hero level))
 
   (test-equal 
-    (level-find-goal (level-parse "WWWWW\nWP GW\nWWWWW\n"))
+      (vec2 48 16)
-  (vec2 48 16))
+    (level-find-goal level))
 
   (test-equal 
-    (level-find-others (level-parse "WWWWW\nWE EW\nWWWWW\n"))
+      (list (vec2 16 32) (vec2 48 32))
-  (list (vec 16 16) (vec2 48 16)))
+    (level-find-others level))
+  )
 
 (test-end "level")

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

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