diff options
Diffstat (limited to 'examples')
| -rw-r--r-- | examples/tetra/tetra.scm | 695 |
1 files changed, 508 insertions, 187 deletions
diff --git a/examples/tetra/tetra.scm b/examples/tetra/tetra.scm index 2093c2f..5bb2ac5 100644 --- a/examples/tetra/tetra.scm +++ b/examples/tetra/tetra.scm @@ -20,36 +20,76 @@ ;; ;;; Code: -(use-modules (chickadee math matrix) +(use-modules (chickadee math easings) + (chickadee math matrix) (chickadee math rect) (chickadee math vector) (chickadee render color) + (chickadee render font) + (chickadee render particles) (chickadee render texture) (chickadee render sprite) (chickadee scripting) (ice-9 match) (oop goops) (srfi srfi-1) + (srfi srfi-43) (starling asset) (starling kernel) (starling node) (starling node-2d) (starling scene)) + +;;; +;;; Constants +;;; + +(define window-width 600) +(define window-height 800) +(define board-width 10) +(define board-height 20) +(define tile-width 32) +(define tile-height 32) + + +;;; +;;; Assets +;;; + (define (load-block-atlas file-name) (let ((texture (load-image file-name))) - (split-texture texture 32 32))) + (split-texture texture tile-width tile-height))) (define-asset atlas (load-block-atlas "images/blocks.png")) +(define-asset star (load-image "images/star.png")) +(define-asset click-font (load-font "fonts/click.xml")) -(define shapes - '((i (0 0) (0 1) (0 2) (0 3)) - (o (0 0) (0 1) (1 0) (1 1)) - (t (0 0) (0 1) (0 2) (1 1)) - (j (1 0) (1 1) (1 2) (0 0)) - (l (0 0) (0 1) (0 2) (1 0)) - (s (1 0) (1 1) (0 2) (0 1)) - (z (0 0) (0 1) (1 2) (1 1)))) + +;;; +;;; Convenience Procedures/Macros +;;; + +(define (transparent color) + "Make a fully transparent version of COLOR." + (make-color (color-r color) + (color-g color) + (color-b color) + 0.0)) + +(define (centered width) + "Return the X coordinate needed to center an object occupying WIDTH +pixels in the right-hand side UI area." + ;; We're not centering it with the full screen, just the portion of + ;; the screen available to the right of the game board. + (let ((board-width-pixels (+ (* board-width tile-width) (* 16.0 2.0)))) + (+ board-width-pixels + (/ (- window-width board-width-pixels width) 2.0)))) + +(define (centered-text text) + "Return the X coordinate needed to center the string TEXT in the UI +area next to the board." + (centered (* (font-line-width (asset-ref click-font) text) 2.0))) (define-syntax for-each-permutation (syntax-rules () @@ -83,47 +123,102 @@ ((_ ((var start end) rest ...) body ...) (map-permutation ((var start end 1) rest ...) body ...)))) -(define rects - (map-permutation ((x 0 4) (y 0 4)) - `((,x ,y) . ,(make-rect (* x 32.0) (* y 32.0) 32.0 32.0)))) + +;;; +;;; Tiles +;;; +;; A single block on a tetris board. (define-class <tile> () (type #:accessor type #:init-form #f) - (position #:accessor position #:init-keyword #:position)) - -(define (type->atlas-index type) - (match type - ('yellow 0) - ('blue 1) - ('green 2) - ('purple 3) - ('red 4) - ('gray 5) - (_ #f))) + (area #:getter area #:init-keyword #:area)) (define (for-each-coord proc) - (for-each-permutation ((x 0 10) (y 0 20)) (proc x y))) - -(define (make-tiles) - (let ((tiles (make-array #f 10 20))) - (for-each-coord - (lambda (x y) - (array-set! tiles - (make <tile> - #:position (vec2 (* x 32.0) - (* y 32.0))) - x y))) - tiles)) + (for-each-permutation ((x 0 board-width) (y 0 board-height)) (proc x y))) + + +;;; +;;; Pieces +;;; +;; Moveable tetromino. (define-class <piece> (<node-2d>) (x #:accessor x #:init-keyword #:x #:init-form 0) (y #:accessor y #:init-keyword #:y #:init-form 0) (type #:accessor type #:init-keyword #:type) - (shape #:accessor shape #:init-keyword #:shape) - (batch #:accessor batch #:init-keyword #:batch)) + (shape #:accessor shape #:init-keyword #:shape)) + +(define shapes + '((i (0 1) (1 1) (2 1) (3 1)) + (j (0 0) (1 0) (2 0) (0 1)) + (l (0 0) (1 0) (2 0) (2 1)) + (o (0 0) (0 1) (1 0) (1 1)) + (s (0 0) (1 0) (1 1) (2 1)) + (t (0 0) (1 0) (2 0) (1 1)) + (z (0 1) (1 1) (1 0) (2 0)))) + +(define colors + '((i . yellow) + (j . blue) + (l . red) + (o . purple) + (s . green) + (t . gray) + (z . red))) + +(define (type->atlas-index type) + (match type + ('yellow 0) + ('blue 0) + ('green 0) + ('purple 0) + ('red 0) + ('gray 0) + (_ #f))) + +;; A convenient cache of all the possible sprite locations with a +;; tetrnomino to avoid recalculating them all the time. +(define rects + (map-permutation ((x 0 4) (y 0 4)) + `((,x ,y) . ,(make-rect (* x tile-width) + (* y tile-height) + tile-width + tile-height)))) + +(define-method (piece-width (piece <piece>)) + (let loop ((shape (shape piece)) + (minx #f) + (maxx #f)) + (match shape + (() (+ (- maxx minx) 1)) + (((x _) . rest) + (loop rest + (if minx (min minx x) x) + (if maxx (max maxx x) x)))))) + +(define-method (piece-height (piece <piece>)) + (let loop ((shape (shape piece)) + (miny #f) + (maxy #f)) + (match shape + (() (+ (- maxy miny) 1)) + (((_ y) . rest) + (loop rest + (if miny (min miny y) y) + (if maxy (max maxy y) y)))))) + +(define-method (piece-y-offset (piece <piece>)) + (fold (lambda (p memo) + (match p + ((_ y) + (if memo + (min y memo) + y)))) + #f + (shape piece))) (define-method (max-x (piece <piece>)) - (- 9 + (- board-width 1 (fold (lambda (p memo) (match p ((x _) @@ -131,80 +226,132 @@ 0 (shape piece)))) -(define-method (piece-above-board? (piece <piece>)) - (let ((py (y piece))) - (any (match-lambda - ((_ y) - (>= (+ y py) 20))) - (shape piece)))) - -(define-method (move-piece (piece <piece>) new-x new-y) +(define-method (move-piece (piece <piece>) new-x new-y init?) (let ((old-x (x piece)) - (old-y (y piece))) + (old-y (y piece)) + (px (* new-x tile-width)) + (py (* new-y tile-height))) (set! (x piece) new-x) (set! (y piece) new-y) - (with-agenda (agenda piece) - (script - (move-to piece (* old-x 32.0) (* old-y 32.0)) - (move-to piece (* new-x 32.0) (* new-y 32.0) 8))))) + (if init? + (teleport piece px py) + (run-script piece + (move-to piece px py 8))))) -(define-method (rotate-piece (piece <piece>)) - (let* ((max-y (fold (lambda (pos memo) - (match pos - ((x y) - (max y memo)))) - 0 - (shape piece))) - (new-shape (map (match-lambda - ((x y) - (list (- max-y y) x))) - (shape piece))) - (px (x piece)) - (py (y piece))) - (when (every (match-lambda - ((x y) - (let ((sx (+ x px)) - (sy (+ y py))) - (and (>= sx 0) - (< sx 10) - (>= sy 0))))) - new-shape) - (set! (shape piece) new-shape)))) +(define-method (move-piece (piece <piece>) new-x new-y) + (move-piece piece new-x new-y #f)) (define-method (render (piece <piece>) alpha) - (let ((batch (batch piece))) - (for-each (match-lambda - (pos - (sprite-batch-add* batch - (assoc-ref rects pos) - (world-matrix piece) - #:texture-region - (texture-atlas-ref (asset-ref atlas) - (type->atlas-index - (type piece)))))) - (shape piece)))) + (for-each (match-lambda + (pos + (draw-sprite* (texture-atlas-ref (asset-ref atlas) + (type->atlas-index + (type piece))) + (assoc-ref rects pos) + (world-matrix piece)))) + (shape piece))) + +(define (make-random-piece) + (let ((type (list-ref '(i o t j l s z) (random 7)))) + (make <piece> + #:type (assq-ref colors type) + #:shape (assq-ref shapes type) + #:rank 999))) + + +;;; +;;; Rows +;;; -(define (make-random-piece batch) - (let* ((shape (assq-ref shapes (list-ref '(i o t j l s z) (random 7)))) - (piece (make <piece> - #:type (list-ref '(yellow blue red purple green gray) - (random 6)) - #:shape shape - #:batch batch - #:x 4 - #:y 20))) - (move-to piece (* 4.0 32.0) (* 20.0 32.0)) - piece)) +;; A horizontal line of tiles on the tetris board. +(define-class <row> (<node-2d>) + (y #:accessor y #:init-keyword #:y) + (tiles #:accessor tiles #:init-keyword #:tiles)) +(define-method (on-boot (row <row>)) + (teleport row 0.0 (* (y row) tile-height))) + +(define-method (render (row <row>) alpha) + (let ((tiles (tiles row)) + (batch (batch (parent row))) + (atlas (asset-ref atlas))) + (let loop ((x 0)) + (when (< x board-width) + (let* ((tile (vector-ref tiles x)) + (i (type->atlas-index (type tile)))) + (when i + (sprite-batch-add* batch + (area tile) + (world-matrix row) + #:texture-region (texture-atlas-ref atlas i)))) + (loop (+ x 1)))))) + +(define-method (on-clear (row <row>) particles) + (run-script row + (scale-to row 0.0 0.0 10) + (detach row)) + ;; Emit some particles! woooooo + (let* ((pos (position row)) + (x (vec2-y pos)) + (y (vec2-y pos))) + (vector-for-each (lambda (i tile) + (let* ((area (make-rect (* i tile-width) + y + tile-width + tile-height)) + (emitter (make-particle-emitter area 2 10))) + (add-particle-emitter particles emitter))) + (tiles row)))) + +(define (make-row y) + (define (make-tile x) + (make <tile> + #:area (make-rect (* x tile-width) + 0.0 + tile-width + tile-height))) + (let ((row (make-vector board-width))) + (vector-for-each (lambda (x e) + (vector-set! row x (make-tile x))) + row) + (make <row> #:y y #:tiles row))) + + +;;; +;;; Boards +;;; + +;; A collection of rows forming the complete tetris game board. (define-class <board> (<node-2d>) (batch #:accessor batch #:init-keyword #:batch) - (tiles #:getter tiles #:init-thunk make-tiles)) + (rows #:accessor rows #:init-form (make-vector board-height #f))) + +(define-method (on-boot (board <board>)) + (set! (batch board) (make-sprite-batch #f)) + (attach-to board + (make <filled-rect> + #:name 'background + #:region (make-rect 0.0 0.0 320.0 640.0) + #:color tango-aluminium-6) + (make <sprite-batch> + #:name 'batch + #:batch (batch board)) + (make <particles> + #:name 'particles + #:particles (make-particles 2000 + #:texture (asset-ref star) + #:start-color tango-butter + #:end-color (transparent tango-butter) + #:lifetime 10)))) + +(define-method (get-tile (board <board>) x y) + (vector-ref (tiles (vector-ref (rows board) y)) x)) (define-method (board-ref (board <board>) x y) - (type (array-ref (tiles board) x y))) + (type (get-tile board x y))) (define-method (board-set! (board <board>) x y new-type) - (set! (type (array-ref (tiles board) x y)) new-type)) + (set! (type (get-tile board x y)) new-type)) (define-method (add-to-board (board <board>) (piece <piece>)) (let ((type (type piece)) @@ -214,112 +361,273 @@ ((sx sy) (let ((bx (+ x sx)) (by (+ y sy))) - (when (< by 20) + (when (< by board-height) (board-set! board bx by type))))) (shape piece)))) +(define-method (overlaps-board? (piece <piece>) (board <board>)) + (let ((px (x piece)) + (py (y piece))) + (any (match-lambda + ((x y) + (board-ref board (+ x px) (+ y py)))) + (shape piece)))) + +(define-method (out-of-bounds? (piece <piece>)) + (let ((px (x piece)) + (py (y piece))) + (any (match-lambda + ((x y) + (let ((sx (+ x px)) + (sy (+ y py))) + (or (< sx 0) + (>= sx board-width) + (< sy 0) + (>= sy board-height))))) + (shape piece)))) + +(define-method (rotate-piece (piece <piece>) (board <board>)) + (let* ((max-y (fold (lambda (pos memo) + (match pos + ((x y) + (max y memo)))) + 0 + (shape piece))) + (old-shape (shape piece)) + (new-shape (map (match-lambda + ((x y) + (list (- max-y y) x))) + old-shape))) + (set! (shape piece) new-shape) + (when (or (out-of-bounds? piece) + (overlaps-board? piece board)) + (set! (shape piece) old-shape)))) + (define-method (filled-rows (board <board>)) (define (row-full? y) (let loop ((x 0)) (cond - ((= x 10) + ((= x board-width) #t) ((board-ref board x y) (loop (+ x 1))) (else #f)))) - (let loop ((y 0)) - (if (= y 20) + (let loop ((y 19)) + (if (< y 0) '() (if (row-full? y) - (cons y (loop (+ y 1))) - (loop (+ y 1)))))) + (cons y (loop (- y 1))) + (loop (- y 1)))))) (define-method (remove-filled-rows (board <board>)) - (let loop ((rows (filled-rows board))) - (match rows - (() #t) - ((y . rest) - (let y-loop ((y (+ y 1))) - (when (< y 20) - (let x-loop ((x 0)) - (when (< x 10) - (board-set! board x (- y 1) (board-ref board x y)) - (x-loop (+ x 1)))) - (y-loop (+ y 1)))) - (loop rest))))) - -(define-method (board-clear! (board <board>)) - (for-each-coord - (lambda (x y) - (set! (type (array-ref (tiles board) x y)) #f)))) + (let* ((rows (rows board)) + (rows-to-remove (filled-rows board)) + (anim-duration 10)) + (let loop ((dead-rows rows-to-remove) + (count 0)) + (match dead-rows + (() (length rows-to-remove)) + ((dead-y . rest) + ;; Remove the cleared row. + (let ((dead-row (vector-ref rows dead-y)) + (particles (particles (& board particles)))) + (on-clear dead-row particles)) + ;; Move everything above the cleared row down. + (let y-loop ((old-y (+ dead-y 1))) + (when (< old-y board-height) + (let ((row (vector-ref rows old-y)) + (new-y (- old-y 1))) + (vector-set! rows new-y row) + (set! (y row) new-y) + ;; Smoothly animate the drop down. + (run-script row + (unless (zero? count) + (sleep (* count anim-duration))) + (move-to row 0.0 (* new-y tile-height) anim-duration + (if (zero? count) smoothstep linear)))) + (y-loop (+ old-y 1)))) + ;; Add a new blank row to the top. + (let ((new-row (make-row (- board-height 1)))) + (attach-to board new-row) + (vector-set! rows (- board-height 1) new-row)) + (loop rest (+ count 1))))))) + +(define-method (clear-board (board <board>)) + (let ((rows (rows board))) + (when rows + (let loop ((y 0)) + (when (< y board-height) + (let ((old-row (vector-ref rows y))) + (and old-row (detach old-row))) + (let ((new-row (make-row y))) + (vector-set! rows y new-row) + (attach-to board new-row)) + (loop (+ y 1))))))) (define-method (touching-next-row? (piece <piece>) (board <board>)) (any (match-lambda ((sx sy) (let ((bx (+ (x piece) sx)) (by (- (+ (y piece) sy) 1))) - (and (< by 20) - (board-ref board bx by))))) + (or (= by -1) + (and (< by board-height) + (board-ref board bx by)))))) (shape piece))) -(define-method (render (board <board>) alpha) - (let ((tiles (tiles board)) - (batch (batch board)) - (atlas (asset-ref atlas))) - (for-each-coord - (lambda (x y) - (let* ((tile (array-ref tiles x y)) - (i (type->atlas-index (type tile)))) - (when i - (sprite-batch-add! batch (position tile) - #:texture-region (texture-atlas-ref atlas i)))))))) +(define-method (render-tree (board <board>) alpha) + (set-sprite-batch-texture! (batch board) + (texture-atlas-texture (asset-ref atlas))) + (next-method)) + + +;;; +;;; Tetra +;;; + +;; The main game scene. (define-class <tetra> (<scene-2d>) (state #:accessor state #:init-form 'play) - (batch #:getter batch #:init-form (make-sprite-batch #f)) - (board #:accessor board #:init-form (make <board>)) + (board #:accessor board) (piece #:accessor piece #:init-form #f) + (next-piece #:accessor next-piece #:init-form #f) (timer #:accessor timer #:init-form 0) - (down-interval #:accessor down-interval #:init-form 30)) + (down-interval #:accessor down-interval #:init-form 30) + (score #:accessor score #:init-form -1)) + +(define-method (game-over (tetra <tetra>)) + (set! (state tetra) 'game-over) + (let* ((message "GAME OVER") + (instructions "press ENTER to play again") + (font (asset-ref click-font)) + (message-width (* (font-line-width font message) 2.0)) + (instructions-width (* (font-line-width font instructions) 2.0)) + (line-height (* (font-line-height font) 2.0)) + (padding 16.0) + (border 2.0) + (container-width (+ (max message-width instructions-width) (* padding 2.0))) + (container-height (+ (* line-height 2) (* padding 3.0))) + (container (make <node-2d> + #:name 'game-over-container + #:rank 9999 + #:position (vec2 (- (+ (/ (* board-width tile-width) 2.0) 16.0) + (/ container-width 2.0)) + (/ (- window-height container-height) 2.0))))) + (attach-to container + (make <filled-rect> + #:name 'background + #:region (make-rect 0.0 0.0 container-width container-height) + #:color tango-aluminium-3) + (make <filled-rect> + #:name 'background + #:region (make-rect border + border + (- container-width (* border 2.0)) + (- container-height (* border 2.0))) + #:color tango-aluminium-6) + (make <label> + #:name 'message + #:text message + #:font click-font + #:scale (vec2 2.0 2.0) + #:position (vec2 (/ (- container-width message-width) 2.0) + (+ line-height (* padding 2.0)))) + (make <label> + #:name 'instructions + #:text instructions + #:font click-font + #:scale (vec2 2.0 2.0) + #:position (vec2 (/ (- container-width instructions-width) 2.0) + padding))) + (attach-to tetra container))) + +(define-method (add-next-piece (tetra <tetra>)) + (let* ((new-piece (make-random-piece)) + (w (* (piece-width new-piece) tile-width)) + (h (* (piece-height new-piece) tile-height)) + (y-offset (+ (/ (- (* tile-height 3.0) h) 2.0) + (* (piece-y-offset new-piece) tile-height))) + (x (centered w)) + (y (- 630.0 16.0 h y-offset))) + (teleport new-piece x y) + (set! (next-piece tetra) new-piece) + (attach-to tetra new-piece))) (define-method (add-new-piece (tetra <tetra>)) - (let ((new-piece (make-random-piece (batch tetra)))) - (when (piece tetra) - (detach (piece tetra))) - (set! (piece tetra) new-piece) - (set! (timer tetra) 0) - (attach-to tetra new-piece))) + (let ((new-piece (next-piece tetra))) + (detach new-piece) + (attach-to (& tetra board-container) new-piece) + (move-piece new-piece 4 18 #t) + (if (overlaps-board? new-piece (board tetra)) + (begin + (detach new-piece) + (game-over tetra)) + (begin + (when (piece tetra) + (detach (piece tetra))) + (set! (piece tetra) new-piece) + (set! (timer tetra) 0) + (add-next-piece tetra))))) (define-method (on-boot (tetra <tetra>)) - (set! (batch (board tetra)) (batch tetra)) + (set! (board tetra) (make <board>)) (attach-to tetra (make <filled-rect> - #:name 'background - #:region (make-rect 0.0 0.0 320.0 640.0) - #:color tango-light-sky-blue) - (board tetra) - (make <sprite-batch> - #:batch (batch tetra) - #:rank 9999)) - (add-new-piece tetra)) + #:region (make-rect 0.0 0.0 window-width window-height) + #:color tango-aluminium-5) + (let ((text "NEXT")) + (make <label> + #:name 'next-label + #:text text + #:font click-font + #:position (vec2 (centered-text text) 630.0) + #:scale (vec2 2.0 2.0))) + (make <filled-rect> + #:name 'next-background + #:color tango-aluminium-6 + #:region (let* ((w (* tile-width 5.0)) + (h (* tile-height 3.0)) + (x (centered w)) + (y (- 630.0 h 16.0))) + (make-rect x y w h))) + (let ((text "HI CHRIS")) + (make <label> + #:name 'score-label + #:text text + #:font click-font + #:position (vec2 (centered-text text) 420.0) + #:scale (vec2 2.0 2.0))) + (make <label> + #:name 'score-counter + #:font click-font + #:scale (vec2 2.0 2.0)) + (make <node-2d> + #:name 'board-container + #:position (vec2 16.0 + (/ (- window-height + (* board-height tile-height)) + 2.0)))) + (attach-to (& tetra board-container) + (board tetra)) + (reset-game tetra)) (define-method (move-piece (tetra <tetra>) dx dy) (let* ((p (piece tetra)) (b (board tetra)) (new-x (min (max (+ (x p) dx) 0) (max-x p))) - (new-y (max (+ (y p) dy) 0))) + (new-y (+ (y p) dy))) (define (touch?) (any (match-lambda ((sx sy) (let ((bx (+ new-x sx)) (by (+ new-y sy))) - (and (>= bx 0) - (< bx 10) - (>= by 0) - (< by 20) - (board-ref b bx by))))) + (or (< bx 0) + (>= bx board-width) + (< by 0) + (>= by board-height) + (board-ref b bx by))))) (shape p))) (when (and p (not (touch?))) (move-piece p new-x new-y)))) @@ -327,16 +635,32 @@ (define-method (rotate-piece (tetra <tetra>)) (let ((p (piece tetra))) (when p - (rotate-piece p)))) + (rotate-piece p (board tetra))))) + +(define-method (change-score (tetra <tetra>) new-score) + (unless (= new-score (score tetra)) + (let ((score-text (number->string new-score)) + (label (& tetra score-counter))) + (set! (score tetra) new-score) + (set! (text label) score-text) + (teleport label (centered-text score-text) 380.0)))) (define-method (reset-game (tetra <tetra>)) (set! (state tetra) 'play) (set! (timer tetra) 0) - (board-clear! (board tetra)) + (when (piece tetra) + (detach (piece tetra))) + (when (next-piece tetra) + (detach (next-piece tetra))) + (set! (piece tetra) #f) + (set! (next-piece tetra) #f) + (clear-board (board tetra)) + (add-next-piece tetra) (add-new-piece tetra) - (let ((game-over-text (& tetra game-over-text))) - (when game-over-text - (detach game-over-text)))) + (change-score tetra 0) + (let ((game-over-container (& tetra game-over-container))) + (when game-over-container + (detach game-over-container)))) (define-method (on-key-press (tetra <tetra>) key scancode modifiers repeat?) (match (state tetra) @@ -360,32 +684,29 @@ (when (= (timer tetra) (down-interval tetra)) (let ((p (piece tetra)) (b (board tetra))) - (when (or (zero? (y p)) - (touching-next-row? p b)) - (if (piece-above-board? p) - (begin - (set! (state tetra) 'game-over) - (attach-to tetra - (make <label> - #:name 'game-over-text - #:text "*** GAME OVER ***\n\n\nPress ENTER to play again" - #:position (vec2 340.0 620.0)))) - (begin - (add-to-board b p) - (remove-filled-rows b) - (add-new-piece tetra)))) - (move-piece tetra 0 -1) + (if (touching-next-row? p b) + (begin + (add-to-board b p) + (change-score tetra (+ (score tetra) + ;; Calculate score based on how + ;; many rows were cleared by + ;; placing the tetromino. + (match (remove-filled-rows b) + (0 0) + (1 40) + (2 100) + (3 300) + (4 1200)))) + (add-new-piece tetra)) + (move-piece tetra 0 -1)) (set! (timer tetra) 0))))) -(define-method (render-tree (tetra <tetra>) alpha) - (set-sprite-batch-texture! (batch tetra) - (texture-atlas-texture (asset-ref atlas))) - (next-method)) - +;; Seed the random number generator. +(set! *random-state* (random-state-from-platform)) (boot-kernel (make <kernel> #:window-config (make <window-config> - #:title "tetris clone" - #:width 600 - #:height 800)) + #:title "tetra" + #:width window-width + #:height window-height)) (lambda () (make <tetra>))) |