X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8678d9e413593b0abab296551a20589745c459da..b6b565b4a1d0fedede8dbd325af1d4c63ec5ec58:/lisp/play/tetris.el

diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el
index 2935ff04c9..d4ab668a4e 100644
--- a/lisp/play/tetris.el
+++ b/lisp/play/tetris.el
@@ -1,6 +1,6 @@
 ;;; tetris.el --- implementation of Tetris for Emacs
 
-;; Copyright (C) 1997, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2016 Free Software Foundation, Inc.
 
 ;; Author: Glynn Clements <glynn@sensei.co.uk>
 ;; Version: 2.01
@@ -26,8 +26,7 @@
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
 (require 'gamegrid)
 
@@ -78,26 +77,25 @@ If the return value is a number, it is used as the timer period."
   ["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 nil))
-	  (while names
-	    (add-to-list 'result
-			 (cons 'choice
-			       (cons :tag
-				     (cons (car names)
-					   (mapcar (lambda (color)
-						     (list 'const color))
-						   (defined-colors)))))
-			 t)
-	    (setq names (cdr names)))
-	  result))
+  :type '(vector (color :tag "Shape 1")
+		 (color :tag "Shape 2")
+		 (color :tag "Shape 3")
+		 (color :tag "Shape 4")
+		 (color :tag "Shape 5")
+		 (color :tag "Shape 6")
+		 (color :tag "Shape 7")))
 
 (defcustom tetris-x-colors
   [[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."
+  "Vector of RGB colors of the various shapes."
   :group 'tetris
-  :type 'sexp)
+  :type '(vector (vector :tag "Shape 1" number number number)
+                 (vector :tag "Shape 2" number number number)
+                 (vector :tag "Shape 3" number number number)
+                 (vector :tag "Shape 4" number number number)
+                 (vector :tag "Shape 5" number number number)
+                 (vector :tag "Shape 6" number number number)
+                 (vector :tag "Shape 7" number number number)))
 
 (defcustom tetris-buffer-name "*Tetris*"
   "Name used for Tetris buffer."
@@ -193,32 +191,32 @@ If the return value is a number, it is used as the timer period."
 ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defconst tetris-shapes
-  [[[[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]] 
+  [[[[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] [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 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
@@ -236,7 +234,7 @@ each one of its four blocks.")
 
 (defconst tetris-space 9)
 
-(defun tetris-default-update-speed-function (shapes rows)
+(defun tetris-default-update-speed-function (_shapes rows)
   (/ 20.0 (+ 50.0 rows)))
 
 ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -273,7 +271,7 @@ each one of its four blocks.")
     (define-key map [left]	'tetris-move-left)
     (define-key map [right]	'tetris-move-right)
     (define-key map [up]	'tetris-rotate-prev)
-    (define-key map [down]	'tetris-rotate-next)
+    (define-key map [down]	'tetris-move-down)
     map))
 
 (defvar tetris-null-map
@@ -285,20 +283,20 @@ each one of its four blocks.")
 
 (defun tetris-display-options ()
   (let ((options (make-vector 256 nil)))
-    (loop for c from 0 to 255 do
+    (dotimes (c 256)
       (aset options c
 	    (cond ((= c tetris-blank)
-		    tetris-blank-options)
+                   tetris-blank-options)
                   ((and (>= c 0) (<= c 6))
 		   (append
 		    tetris-cell-options
 		    `((((glyph color-x) ,(aref tetris-x-colors c))
 		       (color-tty ,(aref tetris-tty-colors c))
 		       (t nil)))))
-		   ((= c tetris-border)
-		    tetris-border-options)
-		   ((= c tetris-space)
-		    tetris-space-options)
+                  ((= c tetris-border)
+                   tetris-border-options)
+                  ((= c tetris-space)
+                   tetris-space-options)
                   (t
                    '(nil nil nil)))))
     options))
@@ -325,13 +323,13 @@ each one of its four blocks.")
   (let ((strings (vector (format "Shapes: %05d" tetris-n-shapes)
 			 (format "Rows:   %05d" tetris-n-rows)
 			 (format "Score:  %05d" tetris-score))))
-    (loop for y from 0 to 2 do
-	  (let* ((string (aref strings y))
-		 (len (length string)))
-	    (loop for x from 0 to (1- len) do
-		  (gamegrid-set-cell (+ tetris-score-x x)
-				     (+ tetris-score-y y)
-				     (aref string x)))))))
+    (dotimes (y 3)
+      (let* ((string (aref strings y))
+             (len (length string)))
+        (dotimes (x len)
+          (gamegrid-set-cell (+ tetris-score-x x)
+                             (+ tetris-score-y y)
+                             (aref string x)))))))
 
 (defun tetris-update-score ()
   (tetris-draw-score)
@@ -351,88 +349,88 @@ each one of its four blocks.")
     (tetris-update-score)))
 
 (defun tetris-draw-next-shape ()
-  (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))))
+  (dotimes (x 4)
+    (dotimes (y 4)
+      (gamegrid-set-cell (+ tetris-next-x x)
+                         (+ tetris-next-y y)
+                         tetris-blank)))
+  (dotimes (i 4)
+    (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 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))))
+  (dotimes (i 4)
+    (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 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))))
+  (dotimes (i 4)
+    (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 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))))))
+    (dotimes (i 4)
+      (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)
   (let ((full t))
-    (loop for x from 0 to (1- tetris-width) do
-	  (if (= (gamegrid-get-cell (+ tetris-top-left-x x)
-				    (+ tetris-top-left-y y))
-		 tetris-blank)
-	      (setq full nil)))
+    (dotimes (x tetris-width)
+      (if (= (gamegrid-get-cell (+ tetris-top-left-x x)
+                                (+ tetris-top-left-y y))
+             tetris-blank)
+          (setq full nil)))
     full))
 
 (defun tetris-shift-row (y)
   (if (= y 0)
-      (loop for x from 0 to (1- tetris-width) do
+      (dotimes (x tetris-width)
 	(gamegrid-set-cell (+ tetris-top-left-x x)
 			   (+ tetris-top-left-y y)
 			   tetris-blank))
-  (loop for x from 0 to (1- tetris-width) do
-	(let ((c (gamegrid-get-cell (+ tetris-top-left-x x)
-				    (+ tetris-top-left-y y -1))))
-	  (gamegrid-set-cell (+ tetris-top-left-x x)
-			     (+ tetris-top-left-y y)
+    (dotimes (x tetris-width)
+      (let ((c (gamegrid-get-cell (+ tetris-top-left-x x)
+                                  (+ tetris-top-left-y y -1))))
+        (gamegrid-set-cell (+ tetris-top-left-x x)
+                           (+ tetris-top-left-y y)
 			   c)))))
 
 (defun tetris-shift-down ()
-  (loop for y0 from 0 to (1- tetris-height) do
-	(if (tetris-full-row y0)
-	    (progn (setq tetris-n-rows (1+ tetris-n-rows))
-		   (loop for y from y0 downto 0 do
-			 (tetris-shift-row y))))))
+  (dotimes (y0 tetris-height)
+    (when (tetris-full-row y0)
+      (setq tetris-n-rows (1+ tetris-n-rows))
+      (cl-loop for y from y0 downto 0 do
+               (tetris-shift-row y)))))
 
 (defun tetris-draw-border-p ()
   (or (not (eq gamegrid-display-mode 'glyph))
@@ -444,22 +442,22 @@ each one of its four blocks.")
 			tetris-space)
   (let ((buffer-read-only nil))
     (if (tetris-draw-border-p)
-	(loop for y from -1 to tetris-height do
-	      (loop for x from -1 to tetris-width do
-		    (gamegrid-set-cell (+ tetris-top-left-x x)
-				       (+ tetris-top-left-y y)
-				       tetris-border))))
-    (loop for y from 0 to (1- tetris-height) do
-	  (loop for x from 0 to (1- tetris-width) do
-		(gamegrid-set-cell (+ tetris-top-left-x x)
-				   (+ tetris-top-left-y y)
-				   tetris-blank)))
+	(cl-loop for y from -1 to tetris-height do
+                 (cl-loop for x from -1 to tetris-width do
+                          (gamegrid-set-cell (+ tetris-top-left-x x)
+                                             (+ tetris-top-left-y y)
+                                             tetris-border))))
+    (dotimes (y tetris-height)
+      (dotimes (x tetris-width)
+        (gamegrid-set-cell (+ tetris-top-left-x x)
+                           (+ tetris-top-left-y y)
+                           tetris-blank)))
     (if (tetris-draw-border-p)
-	(loop for y from -1 to 4 do
-	      (loop for x from -1 to 4 do
-		    (gamegrid-set-cell (+ tetris-next-x x)
-				       (+ tetris-next-y y)
-				       tetris-border))))))
+	(cl-loop for y from -1 to 4 do
+                 (cl-loop for x from -1 to 4 do
+                          (gamegrid-set-cell (+ tetris-next-x x)
+                                             (+ tetris-next-y y)
+                                             tetris-border))))))
 
 (defun tetris-reset-game ()
   (gamegrid-kill-timer)
@@ -532,15 +530,25 @@ Drops the shape one square, testing for collision."
 	(setq tetris-pos-x (1- tetris-pos-x)))
     (tetris-draw-shape)))
 
+(defun tetris-move-down ()
+  "Move the shape one square to the bottom."
+  (interactive)
+  (unless tetris-paused
+    (tetris-erase-shape)
+    (setq tetris-pos-y (1+ tetris-pos-y))
+    (if (tetris-test-shape)
+	(setq tetris-pos-y (1- tetris-pos-y)))
+    (tetris-draw-shape)))
+
 (defun tetris-rotate-prev ()
   "Rotate the shape clockwise."
   (interactive)
   (unless tetris-paused
       (tetris-erase-shape)
-      (setq tetris-rot (% (+ 1 tetris-rot) 
+      (setq tetris-rot (% (+ 1 tetris-rot)
                           (tetris-shape-rotations)))
       (if (tetris-test-shape)
-          (setq tetris-rot (% (+ 3 tetris-rot) 
+          (setq tetris-rot (% (+ 3 tetris-rot)
                               (tetris-shape-rotations))))
       (tetris-draw-shape)))
 
@@ -636,8 +644,6 @@ tetris-mode keybindings:
   (tetris-mode)
   (tetris-start-game))
 
-(random t)
-
 (provide 'tetris)
 
 ;;; tetris.el ends here