From 2472663d619f28ac9b79c02d90a298687b046969 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Wed, 26 Jun 2019 10:05:14 -0400
Subject: examples: Update tetra.

---
 examples/tetra/tetra.scm | 62 +++++++++++++++++++++++++++++-------------------
 1 file changed, 37 insertions(+), 25 deletions(-)

(limited to 'examples/tetra/tetra.scm')

diff --git a/examples/tetra/tetra.scm b/examples/tetra/tetra.scm
index be51e63..2093c2f 100644
--- a/examples/tetra/tetra.scm
+++ b/examples/tetra/tetra.scm
@@ -51,23 +51,41 @@
     (s (1 0) (1 1) (0 2) (0 1))
     (z (0 0) (0 1) (1 2) (1 1))))
 
+(define-syntax for-each-permutation
+  (syntax-rules ()
+    ((_ () body ...)
+     (begin body ...))
+    ((_ ((var start end inc) rest ...) body ...)
+     (let loop ((i start))
+       (when (< i end)
+         (let ((var i))
+           (for-each-permutation (rest ...) body ...))
+         (loop (+ i inc)))))
+    ((_ ((var start end) rest ...) body ...)
+     (for-each-permutation ((var start end 1) rest ...) body ...))))
+
+(define-syntax map-permutation
+  (syntax-rules ()
+    ((_ ((var start end inc)) body ...)
+     (let loop ((i start))
+       (if (< i end)
+           (let ((var i))
+             (cons (begin body ...)
+                   (loop (+ i 1))))
+           '())))
+    ((_ ((var start end inc) rest ...) body ...)
+     (let loop ((i start))
+       (if (< i end)
+           (let ((var i))
+             (append (map-permutation (rest ...) body ...)
+                     (loop (+ i 1))))
+           '())))
+    ((_ ((var start end) rest ...) body ...)
+     (map-permutation ((var start end 1) rest ...) body ...))))
+
 (define rects
-  `(((0 0) . ,(rect 0.0 0.0 32.0 32.0))
-    ((0 1) . ,(rect 0.0 32.0 32.0 32.0))
-    ((0 2) . ,(rect 0.0 64.0 32.0 32.0))
-    ((0 3) . ,(rect 0.0 96.0 32.0 32.0))
-    ((1 0) . ,(rect 32.0 0.0 32.0 32.0))
-    ((1 1) . ,(rect 32.0 32.0 32.0 32.0))
-    ((1 2) . ,(rect 32.0 64.0 32.0 32.0))
-    ((1 3) . ,(rect 32.0 96.0 32.0 32.0))
-    ((2 0) . ,(rect 64.0 0.0 32.0 32.0))
-    ((2 1) . ,(rect 64.0 32.0 32.0 32.0))
-    ((2 2) . ,(rect 64.0 64.0 32.0 32.0))
-    ((2 3) . ,(rect 64.0 96.0 32.0 32.0))
-    ((3 0) . ,(rect 96.0 0.0 32.0 32.0))
-    ((3 1) . ,(rect 96.0 32.0 32.0 32.0))
-    ((3 2) . ,(rect 96.0 64.0 32.0 32.0))
-    ((3 3) . ,(rect 96.0 96.0 32.0 32.0))))
+  (map-permutation ((x 0 4) (y 0 4))
+                   `((,x ,y) . ,(make-rect (* x 32.0) (* y 32.0) 32.0 32.0))))
 
 (define-class <tile> ()
   (type #:accessor type #:init-form #f)
@@ -84,13 +102,7 @@
     (_ #f)))
 
 (define (for-each-coord proc)
-  (let y-loop ((y 0))
-    (when (< y 20)
-      (let x-loop ((x 0))
-        (when (< x 10)
-          (proc x y)
-          (x-loop (+ x 1))))
-      (y-loop (+ y 1)))))
+  (for-each-permutation ((x 0 10) (y 0 20)) (proc x y)))
 
 (define (make-tiles)
   (let ((tiles (make-array #f 10 20)))
@@ -284,7 +296,7 @@
   (attach-to tetra
              (make <filled-rect>
                #:name 'background
-               #:region (rect 0.0 0.0 320.0 640.0)
+               #:region (make-rect 0.0 0.0 320.0 640.0)
                #:color tango-light-sky-blue)
              (board tetra)
              (make <sprite-batch>
@@ -365,7 +377,7 @@
         (move-piece tetra 0 -1)
         (set! (timer tetra) 0)))))
 
-(define-method (render* (tetra <tetra>) alpha)
+(define-method (render-tree (tetra <tetra>) alpha)
   (set-sprite-batch-texture! (batch tetra)
                              (texture-atlas-texture (asset-ref atlas)))
   (next-method))
-- 
cgit v1.2.3