Fix up comment convention on the arch-tag lines.
[bpt/emacs.git] / lisp / play / tetris.el
index 045534c..832cba5 100644 (file)
@@ -1,6 +1,7 @@
 ;;; tetris.el --- implementation of Tetris for Emacs
 
-;; Copyright (C) 1997, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005,
+;;   2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Glynn Clements <glynn@sensei.co.uk>
 ;; Version: 2.01
@@ -11,7 +12,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -21,8 +22,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -361,9 +362,9 @@ Element 0 is ignored."
   (setq tetris-pos-y 0)
   (if (tetris-test-shape)
       (tetris-end-game)
-    (tetris-draw-shape))
-  (tetris-draw-next-shape)
-  (tetris-update-score))
+    (tetris-draw-shape)
+    (tetris-draw-next-shape)
+    (tetris-update-score)))
 
 (defun tetris-draw-next-shape ()
   (loop for y from 0 to 3 do
@@ -511,19 +512,21 @@ Drops the shape one square, testing for collision."
 (defun tetris-move-bottom ()
   "Drops the shape to the bottom of the playing area"
   (interactive)
-  (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)))
+  (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))))
 
 (defun tetris-move-left ()
   "Moves the shape one square to the left"
   (interactive)
-  (unless (= tetris-pos-x 0)
+  (unless (or (= tetris-pos-x 0)
+              tetris-paused)
     (tetris-erase-shape)
     (setq tetris-pos-x (1- tetris-pos-x))
     (if (tetris-test-shape)
@@ -533,8 +536,9 @@ Drops the shape one square, testing for collision."
 (defun tetris-move-right ()
   "Moves the shape one square to the right"
   (interactive)
-  (unless (= (+ tetris-pos-x (tetris-shape-width))
-            tetris-width)
+  (unless (or (= (+ tetris-pos-x (tetris-shape-width))
+                 tetris-width)
+              tetris-paused)
     (tetris-erase-shape)
     (setq tetris-pos-x (1+ tetris-pos-x))
     (if (tetris-test-shape)
@@ -544,20 +548,23 @@ Drops the shape one square, testing for collision."
 (defun tetris-rotate-prev ()
   "Rotates the shape clockwise"
   (interactive)
-  (tetris-erase-shape)
-  (setq tetris-rot (% (+ 1 tetris-rot) 4))
-  (if (tetris-test-shape)
-      (setq tetris-rot (% (+ 3 tetris-rot) 4)))
-  (tetris-draw-shape))
+  (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))))
 
 (defun tetris-rotate-next ()
   "Rotates the shape anticlockwise"
   (interactive)
-  (tetris-erase-shape)
-  (setq tetris-rot (% (+ 3 tetris-rot) 4))
-  (if (tetris-test-shape)
-      (setq tetris-rot (% (+ 1 tetris-rot) 4)))
-  (tetris-draw-shape))
+  (if (not tetris-paused)
+      (progn
+        (tetris-erase-shape)
+        (setq tetris-rot (% (+ 3 tetris-rot) 4))
+        (if (tetris-test-shape)
+            (setq tetris-rot (% (+ 1 tetris-rot) 4)))
+        (tetris-draw-shape))))
 
 (defun tetris-end-game ()
   "Terminates the current game"
@@ -601,22 +608,23 @@ tetris-mode keybindings:
   (setq major-mode 'tetris-mode)
   (setq mode-name "Tetris")
 
-  (setq mode-popup-menu
-       '("Tetris Commands"
-         ["Start new game"     tetris-start-game]
-         ["End game"           tetris-end-game
-          (tetris-active-p)]
-         ["Pause"              tetris-pause-game
-          (and (tetris-active-p) (not tetris-paused))]
-         ["Resume"             tetris-pause-game
-          (and (tetris-active-p) tetris-paused)]))
+  (unless (featurep 'emacs)
+    (setq mode-popup-menu
+         '("Tetris Commands"
+           ["Start new game"   tetris-start-game]
+           ["End game"         tetris-end-game
+            (tetris-active-p)]
+           ["Pause"            tetris-pause-game
+            (and (tetris-active-p) (not tetris-paused))]
+           ["Resume"           tetris-pause-game
+            (and (tetris-active-p) tetris-paused)])))
 
   (setq gamegrid-use-glyphs tetris-use-glyphs)
   (setq gamegrid-use-color tetris-use-color)
 
   (gamegrid-init (tetris-display-options))
 
-  (run-hooks 'tetris-mode-hook))
+  (run-mode-hooks 'tetris-mode-hook))
 
 ;;;###autoload
 (defun tetris ()
@@ -644,7 +652,9 @@ tetris-mode keybindings:
   (tetris-mode)
   (tetris-start-game))
 
+(random t)
+
 (provide 'tetris)
 
-;;; arch-tag: fb780d53-3ff0-49f0-8e19-f7f13cf2d49e
+;; arch-tag: fb780d53-3ff0-49f0-8e19-f7f13cf2d49e
 ;;; tetris.el ends here