diff options
Diffstat (limited to 'examples')
| -rwxr-xr-x | examples/tetra/tetra | 7 | ||||
| -rw-r--r-- | examples/tetra/tetra.scm | 62 |
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)) |