Compute corrected object shapes only once.

* scenes/game.scm (<game>)[layers]: Add field.
(populate): Store layers with corrected object shapes.
(collides?): Remove object shape correction.

1 files changed, 32 insertions, 22 deletions

diff --git a/scenes/game.scm b/scenes/game.scm
index f85207b..54e556f 100644
--- a/scenes/game.scm
+++ b/scenes/game.scm
@@ -1,5 +1,5 @@
 ;;; The Inevitable Game
-;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 David Thompson <davet@gnu.org>
 ;;;
 ;;; This program is free software: you can redistribute it and/or
@@ -60,7 +60,9 @@
 (define-class <game> (<scene>)
   (status #:accessor status #:init-form 'playing)
   (tile-map #:accessor tile-map #:init-form test-map)
-  (collision-hitbox #:getter collision-hitbox #:init-form (make-rect 0.0 0.0 0.0 0.0)))
+  (collision-hitbox #:getter collision-hitbox #:init-form (make-rect 0.0 0.0 0.0 0.0))
+  ;; List of layers containing the shapes of objects
+  (layers #:accessor layers #:init-form '()))
 
 (define-class <top-layer> (<node-2d>)
   (tile-map #:accessor tile-map #:init-form test-map))
@@ -87,6 +89,22 @@ positions layer."
         (vec2 0.0 0.0))))
 
 (define-method (populate (game <game>))
+  ;; XXX: Chickadee parses the object layer incorrectly, so all
+  ;; objects are flipped vertically.  We use this to compute the
+  ;; corrected shapes of layer objects only once.
+  (set! (layers game)
+        (map (lambda (layer-name)
+               (cons layer-name
+                     (map (lambda (obj)
+                            (let ((r-wrong (map-object-shape obj)))
+                              (cons obj
+                                    (make-rect (rect-x r-wrong)
+                                               (- (rect-y r-wrong) (rect-height r-wrong))
+                                               (rect-width r-wrong)
+                                               (rect-height r-wrong)))))
+                          (object-layer-objects
+                           (tile-map-layer-ref (asset-ref (tile-map game)) layer-name)))))
+             '("food" "positions" "actions" "collision")))
   (let ((player (lorenzo #:position (location game "player"))))
     (list (reaper (location game "reaper"))
           (make <filled-rect>
@@ -102,7 +120,7 @@ positions layer."
             #:name 'stats #:object player
             #:position (vec2 10.0 (- %height 10.0))))))
 
-(define-method (collides? (player <player>) (game <game>) layer)
+(define-method (collides? (player <player>) (game <game>) layer-name)
   (let* ((pos (position player))
          (offset (origin game))
          (player-hitbox (hitbox player))
@@ -112,26 +130,18 @@ positions layer."
     (set-rect-y! hitbox (+ (- (vec2-y offset)) (vec2-y pos) (rect-y player-hitbox)))
     (set-rect-width! hitbox (rect-width player-hitbox))
     (set-rect-height! hitbox (rect-height player-hitbox))
+    (any (match-lambda
+           ((obj . rect)
+            (and (rect-intersects? hitbox rect)
+                 (begin
+                   (set-rect-x! hit-vis (+ (rect-x rect) (vec2-x offset)))
+                   (set-rect-y! hit-vis (+ (rect-y rect) (vec2-y offset)))
+                   (set-rect-width! hit-vis (rect-width rect))
+                   (set-rect-height! hit-vis (rect-height rect))
+                   obj))))
+         (assoc-ref (layers game) layer-name))))
 
-    ;; TODO: memoize objects and shapes as they don't change.
-    (any (lambda (obj)
-           (let* ((r-wrong (map-object-shape obj))
-                  ;; TODO: chickadee parses the object layer
-                  ;; incorrectly, so all objects are flipped vertically.
-                  (r (make-rect (rect-x r-wrong)
-                                (- (rect-y r-wrong) (rect-height r-wrong))
-                                (rect-width r-wrong)
-                                (rect-height r-wrong))))
-             (and (rect-intersects? hitbox r)
-                  (begin
-                    (set-rect-x! hit-vis (+ (rect-x r) (vec2-x offset)))
-                    (set-rect-y! hit-vis (+ (rect-y r) (vec2-y offset)))
-                    (set-rect-width! hit-vis (rect-width r))
-                    (set-rect-height! hit-vis (rect-height r))
-                    obj))))
-         (object-layer-objects
-          (tile-map-layer-ref (asset-ref (tile-map game)) layer)))))
-
+
 (define-method (update (game <game>) dt)
   ;; Keep the player in the centre
   (let* ((player (child-ref game 'player))