From 783bb9bb595e53ef9940d594bedd047c1100fef9 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Thu, 19 Nov 2020 08:21:41 -0500
Subject: examples: grid: Update to use path module instead of deleted shapes
 module.

---
 examples/grid.scm | 94 +++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 63 insertions(+), 31 deletions(-)

(limited to 'examples')

diff --git a/examples/grid.scm b/examples/grid.scm
index 58ada10..51a4a37 100644
--- a/examples/grid.scm
+++ b/examples/grid.scm
@@ -5,16 +5,50 @@
              (chickadee graphics)
              (chickadee graphics color)
              (chickadee graphics font)
-             (chickadee graphics shapes)
+             (chickadee graphics path)
              (chickadee graphics sprite))
 
 (define grid (make-grid))
-(define item-color (make-color 0.7 0.0 0.0 0.5))
-(define cell-color (make-color 0.0 0.7 0.0 0.2))
+(define item-color (make-color 0.7 0.0 0.0 0.7))
+(define cell-color (make-color 0.0 0.7 0.0 0.4))
 (define player-color (make-color 0.0 0.0 0.7 0.8))
-(define player-pos #v(32.0 32.0))
+(define player-pos (vec2 32.0 32.0))
 (define player-speed 2)
-(define player-velocity #v(0.0 0.0))
+(define player-velocity (vec2 0.0 0.0))
+(define null-vec2 (vec2 0.0 0.0))
+(define last-cell-count -1)
+(define cell-painter
+  (with-style ((fill-color cell-color))
+    (fill (square null-vec2 (grid-cell-size grid)))))
+(define cell-canvas (make-empty-canvas))
+(define item-canvas (make-empty-canvas))
+
+(define (make-cell-painter)
+  (let ((size (grid-cell-size grid)))
+    (apply superimpose
+           (grid-cell-fold (lambda (cell x y memo)
+                             (cons (translate (vec2 (* x size) (* y size))
+                                     cell-painter)
+                                   memo))
+                           '()
+                           grid))))
+
+(define (make-item-painter item rect)
+  (with-style ((fill-color (if (eq? item 'player)
+                               player-color
+                               item-color)))
+    (fill
+     (rectangle (vec2 (rect-x rect)
+                      (rect-y rect))
+                (rect-width rect)
+                (rect-height rect)))))
+
+(define (compose-item-painters)
+  (apply superimpose
+         (grid-item-fold (lambda (item rect memo)
+                           (cons (make-item-painter item rect) memo))
+                         '()
+                         grid)))
 
 (define (load)
   (grid-add grid 'wall-left 0 0 32 480)
@@ -25,7 +59,8 @@
   (grid-add grid 'box-2 300 300 50 100)
   (grid-add grid 'box-3 350 150 200 75)
   (grid-add grid 'box-4 150 140 130 75)
-  (grid-add grid 'player (vec2-x player-pos) (vec2-y player-pos) 32 32))
+  (grid-add grid 'player (vec2-x player-pos) (vec2-y player-pos) 32 32)
+  (set-canvas-painter! item-canvas (compose-item-painters)))
 
 (define (update dt)
   (set-vec2-x! player-velocity 0.0)
@@ -38,17 +73,23 @@
     (set-vec2-x! player-velocity player-speed))
   (when (key-pressed? 'left)
     (set-vec2-x! player-velocity (- player-speed)))
-  (vec2-add! player-pos player-velocity)
-  (grid-move grid 'player player-pos
-             (lambda (a b)
-               (if (eq? a 'player)
-                   slide
-                   #f))))
+  (unless (vec2= player-velocity null-vec2)
+    (vec2-add! player-pos player-velocity)
+    (grid-move grid 'player player-pos
+               (lambda (a b)
+                 (if (eq? a 'player)
+                     slide
+                     #f)))
+    (set-canvas-painter! item-canvas (compose-item-painters)))
+  (let ((cell-count (grid-cell-count grid)))
+    (unless (= cell-count last-cell-count)
+      (set! last-cell-count cell-count)
+      (set-canvas-painter! cell-canvas (make-cell-painter)))))
 
 (define %cell-rect
   (make-rect 0.0 0.0 (grid-cell-size grid) (grid-cell-size grid)))
 (define %cell-count-pos
-  #v(0.0 0.0))
+  (vec2 0.0 0.0))
 
 (define number->string*
   (let ((cache (make-hash-table)))
@@ -60,23 +101,14 @@
               s))))))
 
 (define (draw alpha)
-  (with-blend-mode 'alpha
-    (let ((size (grid-cell-size grid)))
-      (for-each-cell (lambda (cell x y)
-                       (set-rect-x! %cell-rect (* x size))
-                       (set-rect-y! %cell-rect (* y size))
-                       (draw-filled-rect %cell-rect cell-color))
-                     grid)
-      (for-each-cell (lambda (cell x y)
-                       (set-vec2-x! %cell-count-pos (+ (* x size) (/ size 2)))
-                       (set-vec2-y! %cell-count-pos (+ (* y size) (/ size 2)))
-                       (draw-text (number->string* (cell-count cell))
-                                  %cell-count-pos))
-                     grid))
-    (for-each-item (lambda (item rect)
-                     (if (eq? item 'player)
-                         (draw-filled-rect rect player-color)
-                         (draw-filled-rect rect item-color)))
-                   grid)))
+  (draw-canvas cell-canvas)
+  (let ((size (grid-cell-size grid)))
+    (for-each-cell (lambda (cell x y)
+                     (set-vec2-x! %cell-count-pos (+ (* x size) (/ size 2)))
+                     (set-vec2-y! %cell-count-pos (+ (* y size) (/ size 2)))
+                     (draw-text (number->string* (cell-count cell))
+                                %cell-count-pos))
+                   grid))
+  (draw-canvas item-canvas))
 
 (run-game #:load load #:draw draw #:update update)
-- 
cgit v1.2.3