Mercurial > emacs
changeset 109503:ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
(tetris-tty-colors, tetris-x-colors, tetris-blank):
Remove leading nil element, adjust values.
(tetris-shapes, tetris-shape-scores):
Change representation of shapes and remove some redundancy.
(tetris-get-shape-cell, tetris-shape-width, tetris-draw-next-shape)
(tetris-draw-shape, tetris-erase-shape, tetris-test-shape):
Adjust for working with new representation of shapes.
(tetris-shape-rotations): New function.
(tetris-move-bottom, tetris-move-left, tetris-move-right)
(tetris-rotate-prev, tetris-rotate-next):
Adjust for working with the new version of tetris-test-shape.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Sat, 24 Jul 2010 01:26:42 +0200 |
| parents | 293582ab6357 |
| children | 9bc9a6ac1dd8 |
| files | lisp/ChangeLog lisp/play/tetris.el |
| diffstat | 2 files changed, 127 insertions(+), 120 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sat Jul 24 00:51:37 2010 +0200 +++ b/lisp/ChangeLog Sat Jul 24 01:26:42 2010 +0200 @@ -1,3 +1,17 @@ +2010-07-23 Lukas Huonker <l.huonker@gmail.com> + + * play/tetris.el (tetris-tty-colors, tetris-x-colors, tetris-blank): + Remove leading nil element, adjust values. + (tetris-shapes, tetris-shape-scores): + Change representation of shapes and remove some redundancy. + (tetris-get-shape-cell, tetris-shape-width, tetris-draw-next-shape) + (tetris-draw-shape, tetris-erase-shape, tetris-test-shape): + Adjust for working with new representation of shapes. + (tetris-shape-rotations): New function. + (tetris-move-bottom, tetris-move-left, tetris-move-right) + (tetris-rotate-prev, tetris-rotate-next): + Adjust for working with the new version of tetris-test-shape. + 2010-07-23 Markus Triska <markus.triska@gmx.at> * progmodes/ps-mode.el: Use comint (bug#5954).
--- a/lisp/play/tetris.el Sat Jul 24 00:51:37 2010 +0200 +++ b/lisp/play/tetris.el Sat Jul 24 01:26:42 2010 +0200 @@ -76,13 +76,12 @@ :type 'hook) (defcustom tetris-tty-colors - [nil "blue" "white" "yellow" "magenta" "cyan" "green" "red"] - "Vector of colors of the various shapes in text mode. -Element 0 is ignored." + ["blue" "white" "yellow" "magenta" "cyan" "green" "red"] + "Vector of colors of the various shapes in text mode." :group 'tetris :type (let ((names `("Shape 1" "Shape 2" "Shape 3" "Shape 4" "Shape 5" "Shape 6" "Shape 7")) - (result `(vector (const nil)))) + (result nil)) (while names (add-to-list 'result (cons 'choice @@ -96,9 +95,8 @@ result)) (defcustom tetris-x-colors - [nil [0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]] - "Vector of colors of the various shapes. -Element 0 is ignored." + [[0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]] + "Vector of colors of the various shapes." :group 'tetris :type 'sexp) @@ -196,51 +194,44 @@ ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst tetris-shapes - [[[[1 1 0 0] [1 1 0 0] [1 1 0 0] [1 1 0 0]] - [[1 1 0 0] [1 1 0 0] [1 1 0 0] [1 1 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] - - [[[2 2 2 0] [0 2 0 0] [2 0 0 0] [2 2 0 0]] - [[0 0 2 0] [0 2 0 0] [2 2 2 0] [2 0 0 0]] - [[0 0 0 0] [2 2 0 0] [0 0 0 0] [2 0 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] - - [[[3 3 3 0] [3 3 0 0] [0 0 3 0] [3 0 0 0]] - [[3 0 0 0] [0 3 0 0] [3 3 3 0] [3 0 0 0]] - [[0 0 0 0] [0 3 0 0] [0 0 0 0] [3 3 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] - - [[[4 4 0 0] [0 4 0 0] [4 4 0 0] [0 4 0 0]] - [[0 4 4 0] [4 4 0 0] [0 4 4 0] [4 4 0 0]] - [[0 0 0 0] [4 0 0 0] [0 0 0 0] [4 0 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] - - [[[0 5 5 0] [5 0 0 0] [0 5 5 0] [5 0 0 0]] - [[5 5 0 0] [5 5 0 0] [5 5 0 0] [5 5 0 0]] - [[0 0 0 0] [0 5 0 0] [0 0 0 0] [0 5 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] - - [[[0 6 0 0] [6 0 0 0] [6 6 6 0] [0 6 0 0]] - [[6 6 6 0] [6 6 0 0] [0 6 0 0] [6 6 0 0]] - [[0 0 0 0] [6 0 0 0] [0 0 0 0] [0 6 0 0]] - [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] - - [[[7 7 7 7] [7 0 0 0] [7 7 7 7] [7 0 0 0]] - [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]] - [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]] - [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]]]]) + [[[[0 0] [1 0] [0 1] [1 1]]] + + [[[0 0] [1 0] [2 0] [2 1]] + [[1 -1] [1 0] [1 1] [0 1]] + [[0 -1] [0 0] [1 0] [2 0]] + [[1 -1] [2 -1] [1 0] [1 1]]] + + [[[0 0] [1 0] [2 0] [0 1]] + [[0 -1] [1 -1] [1 0] [1 1]] + [[2 -1] [0 0] [1 0] [2 0]] + [[1 -1] [1 0] [1 1] [2 1]]] + + [[[0 0] [1 0] [1 1] [2 1]] + [[1 0] [0 1] [1 1] [0 2]]] + + [[[1 0] [2 0] [0 1] [1 1]] + [[0 0] [0 1] [1 1] [1 2]]] + + [[[1 0] [0 1] [1 1] [2 1]] + [[1 0] [1 1] [2 1] [1 2]] + [[0 1] [1 1] [2 1] [1 2]] + [[1 0] [0 1] [1 1] [1 2]]] + + [[[0 0] [1 0] [2 0] [3 0]] + [[1 -1] [1 0] [1 1] [1 2]]]] + "Each shape is described by a vector that contains the coordinates of +each one of its four blocks.") ;;the scoring rules were taken from "xtetris". Blocks score differently ;;depending on their rotation (defconst tetris-shape-scores - [ [6 6 6 6] [6 7 6 7] [6 7 6 7] [6 7 6 7] [6 7 6 7] [5 5 6 5] [5 8 5 8]] ) + [[6] [6 7 6 7] [6 7 6 7] [6 7] [6 7] [5 5 6 5] [5 8]] ) (defconst tetris-shape-dimensions [[2 2] [3 2] [3 2] [3 2] [3 2] [3 2] [4 1]]) -(defconst tetris-blank 0) +(defconst tetris-blank 7) (defconst tetris-border 8) @@ -299,7 +290,7 @@ (aset options c (cond ((= c tetris-blank) tetris-blank-options) - ((and (>= c 1) (<= c 7)) + ((and (>= c 0) (<= c 6)) (append tetris-cell-options `((((glyph color-x) ,(aref tetris-x-colors c)) @@ -320,20 +311,16 @@ tetris-n-rows nil))) (and (numberp period) period)))) -(defun tetris-get-shape-cell (x y) - (aref (aref (aref (aref tetris-shapes - tetris-shape) - y) - tetris-rot) - x)) +(defun tetris-get-shape-cell (block) + (aref (aref (aref tetris-shapes + tetris-shape) tetris-rot) + block)) (defun tetris-shape-width () - (aref (aref tetris-shape-dimensions tetris-shape) - (% tetris-rot 2))) + (aref (aref tetris-shape-dimensions tetris-shape) 0)) -(defun tetris-shape-height () - (aref (aref tetris-shape-dimensions tetris-shape) - (- 1 (% tetris-rot 2)))) +(defun tetris-shape-rotations () + (length (aref tetris-shapes tetris-shape))) (defun tetris-draw-score () (let ((strings (vector (format "Shapes: %05d" tetris-n-shapes) @@ -365,52 +352,58 @@ (tetris-update-score))) (defun tetris-draw-next-shape () - (loop for y from 0 to 3 do - (loop for x from 0 to 3 do - (gamegrid-set-cell (+ tetris-next-x x) - (+ tetris-next-y y) - (let ((tetris-shape tetris-next-shape) - (tetris-rot 0)) - (tetris-get-shape-cell x y)))))) + (loop for x from 0 to 3 do + (loop for y from 0 to 3 do + (gamegrid-set-cell (+ tetris-next-x x) + (+ tetris-next-y y) + tetris-blank))) + (loop for i from 0 to 3 do + (let ((tetris-shape tetris-next-shape) + (tetris-rot 0)) + (gamegrid-set-cell (+ tetris-next-x + (aref (tetris-get-shape-cell i) 0)) + (+ tetris-next-y + (aref (tetris-get-shape-cell i) 1)) + tetris-shape)))) (defun tetris-draw-shape () - (loop for y from 0 to (1- (tetris-shape-height)) do - (loop for x from 0 to (1- (tetris-shape-width)) do - (let ((c (tetris-get-shape-cell x y))) - (if (/= c tetris-blank) - (gamegrid-set-cell (+ tetris-top-left-x - tetris-pos-x - x) - (+ tetris-top-left-y - tetris-pos-y - y) - c)))))) + (loop for i from 0 to 3 do + (let ((c (tetris-get-shape-cell i))) + (gamegrid-set-cell (+ tetris-top-left-x + tetris-pos-x + (aref c 0)) + (+ tetris-top-left-y + tetris-pos-y + (aref c 1)) + tetris-shape)))) (defun tetris-erase-shape () - (loop for y from 0 to (1- (tetris-shape-height)) do - (loop for x from 0 to (1- (tetris-shape-width)) do - (let ((c (tetris-get-shape-cell x y)) - (px (+ tetris-top-left-x tetris-pos-x x)) - (py (+ tetris-top-left-y tetris-pos-y y))) - (if (/= c tetris-blank) - (gamegrid-set-cell px py tetris-blank)))))) + (loop for i from 0 to 3 do + (let ((c (tetris-get-shape-cell i))) + (gamegrid-set-cell (+ tetris-top-left-x + tetris-pos-x + (aref c 0)) + (+ tetris-top-left-y + tetris-pos-y + (aref c 1)) + tetris-blank)))) (defun tetris-test-shape () (let ((hit nil)) - (loop for y from 0 to (1- (tetris-shape-height)) do - (loop for x from 0 to (1- (tetris-shape-width)) do - (unless hit - (setq hit - (let* ((c (tetris-get-shape-cell x y)) - (xx (+ tetris-pos-x x)) - (yy (+ tetris-pos-y y)) - (px (+ tetris-top-left-x xx)) - (py (+ tetris-top-left-y yy))) - (and (/= c tetris-blank) - (or (>= xx tetris-width) - (>= yy tetris-height) - (/= (gamegrid-get-cell px py) - tetris-blank)))))))) + (loop for i from 0 to 3 do + (unless hit + (setq hit + (let* ((c (tetris-get-shape-cell i)) + (xx (+ tetris-pos-x + (aref c 0))) + (yy (+ tetris-pos-y + (aref c 1)))) + (or (>= xx tetris-width) + (>= yy tetris-height) + (/= (gamegrid-get-cell + (+ xx tetris-top-left-x) + (+ yy tetris-top-left-y)) + tetris-blank)))))) hit)) (defun tetris-full-row (y) @@ -510,33 +503,30 @@ (defun tetris-move-bottom () "Drop the shape to the bottom of the playing area." (interactive) - (if (not tetris-paused) - (let ((hit nil)) - (tetris-erase-shape) - (while (not hit) - (setq tetris-pos-y (1+ tetris-pos-y)) - (setq hit (tetris-test-shape))) - (setq tetris-pos-y (1- tetris-pos-y)) - (tetris-draw-shape) - (tetris-shape-done)))) + (unless tetris-paused + (let ((hit nil)) + (tetris-erase-shape) + (while (not hit) + (setq tetris-pos-y (1+ tetris-pos-y)) + (setq hit (tetris-test-shape))) + (setq tetris-pos-y (1- tetris-pos-y)) + (tetris-draw-shape) + (tetris-shape-done)))) (defun tetris-move-left () "Move the shape one square to the left." (interactive) - (unless (or (= tetris-pos-x 0) - tetris-paused) + (unless tetris-paused (tetris-erase-shape) (setq tetris-pos-x (1- tetris-pos-x)) (if (tetris-test-shape) - (setq tetris-pos-x (1+ tetris-pos-x))) + (setq tetris-pos-x (1+ tetris-pos-x))) (tetris-draw-shape))) (defun tetris-move-right () "Move the shape one square to the right." (interactive) - (unless (or (= (+ tetris-pos-x (tetris-shape-width)) - tetris-width) - tetris-paused) + (unless tetris-paused (tetris-erase-shape) (setq tetris-pos-x (1+ tetris-pos-x)) (if (tetris-test-shape) @@ -546,23 +536,26 @@ (defun tetris-rotate-prev () "Rotate the shape clockwise." (interactive) - (if (not tetris-paused) - (progn (tetris-erase-shape) - (setq tetris-rot (% (+ 1 tetris-rot) 4)) - (if (tetris-test-shape) - (setq tetris-rot (% (+ 3 tetris-rot) 4))) - (tetris-draw-shape)))) + (unless tetris-paused + (tetris-erase-shape) + (setq tetris-rot (% (+ 1 tetris-rot) + (tetris-shape-rotations))) + (if (tetris-test-shape) + (setq tetris-rot (% (+ 3 tetris-rot) + (tetris-shape-rotations)))) + (tetris-draw-shape))) (defun tetris-rotate-next () "Rotate the shape anticlockwise." (interactive) - (if (not tetris-paused) - (progn + (unless tetris-paused (tetris-erase-shape) - (setq tetris-rot (% (+ 3 tetris-rot) 4)) + (setq tetris-rot (% (+ 3 tetris-rot) + (tetris-shape-rotations))) (if (tetris-test-shape) - (setq tetris-rot (% (+ 1 tetris-rot) 4))) - (tetris-draw-shape)))) + (setq tetris-rot (% (+ 1 tetris-rot) + (tetris-shape-rotations)))) + (tetris-draw-shape))) (defun tetris-end-game () "Terminate the current game."