summaryrefslogtreecommitdiff
path: root/examples/tetra
diff options
context:
space:
mode:
Diffstat (limited to 'examples/tetra')
-rwxr-xr-xexamples/tetra/tetra7
-rw-r--r--examples/tetra/tetra.scm62
2 files changed, 44 insertions, 25 deletions
diff --git a/examples/tetra/tetra b/examples/tetra/tetra
new file mode 100755
index 0000000..5690bdb
--- /dev/null
+++ b/examples/tetra/tetra
@@ -0,0 +1,7 @@
+#!/bin/sh
+
+set -e
+cd ../..
+make -j8
+cd -
+DEV_MODE=1 ../../pre-inst-env guile 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))