;;; This is an implementation of tetris. I didn't think to look for one
;;; existing when I started to write it, and actually am kind of glad I
;;; didn't. This one does a little more than the other version I have seen.
;;;
;;; Version 1 was written with tetrii in mind. Tetrii is tetris played
;;; on multiple boards, and a program I wrote for practice in C and
;;; java. For version 1 I ran out of energy before finishing it,though
;;; TETRIS worked, and there were hooks in place to run independently
;;; in multiple buffers simultaneously.
;;;
;;; I finally added tetrii in version 3, and it turned out not to be
;;; too hard. It is not foolproof by any means, though I have tested
;;; it some (ie played it for a while) without any real problems.
;;;
;;; If you find it stops mysteriously, it is probably due to a command
;;; event that was entered accidentally, like a mouse drag. I thought
;;; about redefining all those to tetrii-ignore, but I think just
;;; being careful works as well - or if you do accidentally drag, just
;;; hit "c" to continue. (feature!)

;;; russell young
;;; emacs@young-0.com
;;;
;;; version 1 september 1998
;;;
;;; version 2 February 2005 (wow!)
;;; 	Cleaned up some code
;;;		played a lot
;;;		added the debugging	stuff (apparently unnecessary)
;;;
;;; version 3 September 2005
;;;		added the custom buffer support
;;;		added multiple level lookahead. 
;;;		fixed troublesome intermittant halting bug (see tetris-tick)
;;; 	added tetrii command

(require 'timer)
(require 'cl)
(load "cl-macs")
(require 'wid-edit)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Customizing parameters - these let a player control how the
;; game looks and acts
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; my custom widgets

(defun widget-character-value-get (widget)
  "Return first character in editing field
The original widget for CHARACTER inherited WIDGET-FIELD-VALUE-GET,
which strips trailing blanks. This means it was not possible to input
a single blank character, which should be possible. This just gets the
first character without removing any blanks"
  (let ((from (widget-field-start widget))
		(to (widget-field-end widget)))
    (if (and from to)
		(with-current-buffer (widget-field-buffer widget) (if (> to from) (buffer-substring-no-properties from (1+ from)) ""))
      (widget-get widget :value))))

(define-widget 'character-allow-blank 'character
  "CHARACTER uses EDITABLE-FIELD, which strips trailing blanks.
Unfortunately, in the case of a single blank character this means you
get an empty string. I thought about fixing this for EDITABLE-FIELD,
but decided it is better not to touch it"
  :value-get 'widget-character-value-get
)

(define-widget 'integer-or-nil 'integer
  "Require an integer or nil"
  :match-alternatives '(integerp not)
)

(defgroup tetris nil
  "Tetris and Tetrii

Full-fledged tetris game. Movement is controlled by arrows (left and
right, up and down rotate clockwise and counterclockwise), space key
drops.

Check out the customizing choices, the game can be played with
different sized boards or with random cells filled in to start with.

It also includes tetrii, in which you play multiple tetris boards
simultaneously. You can play this from the keyboard using the same
keys as tetris, with the addition of 1, 2, 3... to jump to the desired
board, or you can play using the mouse pointer - click left to go
left, right to go right, center to rotate, and space to drop, each
action taking place in the window where the mouse pointer is located."
  :group 'games)

;;; game controls
(defcustom tetrii-default-number 2
  "The default number of boards to play tetrii with"
  :group 'tetris
  :type 'integer)

(defcustom tetris-initial-fill-rows 12
  "If 0 or nil start tetris with an empty board and play until it fills up
Otherwise fill this number of rows with Xs (see tetris-initial-fill-%) 
and play until you lose or until the bottom row is cleaned"
  :group 'tetris
  :type 'integer-or-nil)

(defcustom tetris-initial-fill-% 35
  "If `tetris-initial-fill-rows' is nonnull fill in this percentage of the cells"
  :group 'tetris
  :type 'integer)

(defcustom tetris-show-next t
  "The number of upcoming pieces to display
nil is none (0); an integer displays that number; any other value is 1"
  :group 'tetris
  :type 'sexp)

(defcustom tetris-initial-level nil 
  "Start tetris at this level (>= 0)
nil defaults to level 0"
  :group 'tetris
  :type 'integer-or-nil)

(defcustom tetrii-use-mouse t
  "Apply commands to the buffer where the mouse is located
If you want to play using the keyboard method this must be shut off,
or else all commands will be applied to the buffer where the mouse is
rather than the one you have selected."
  :group 'tetris
  :type 'boolean)

(defcustom tetris-drop t
  "If nonnil space drops a piece, otherwise it just goes down 1.
A bonus of a point a level is given for drop."
  :group 'tetris
  :type 'boolean)

;;; high score
(defcustom tetris-score-file "~/tetris.scores"
  "The location of the high score records"
  :group 'tetris
  :type 'file)

(defcustom tetris-high-scores-keep 10
  "The number of scores to keep in the high score record"
  :group 'tetris
  :type 'integer)

;;; display controls
(defcustom tetris-default-height 20
  "The default height of a tetris board"
  :group 'tetris
  :type 'integer)

(defcustom tetris-default-width 10
  "The default width of a tetris board"
  :group 'tetris
  :type 'integer)

(defcustom tetris-double-width t
  "Use double-width characters to fill a cell
Otherwise the board is kind of squashed, this makes each cell
about square."
  :group 'tetris
  :type 'boolean)

(defcustom tetris-background-char ? 
  "The character to use to represent blank cells on the board
Probably should be blank, but others allowed. Do not choose one 
of the characters '-XljtzshoLJTZSHO|' which are used for other 
purposes, and will not work properly"
  :group 'tetris
  :type 'character-allow-blank)

(defcustom tetris-boss-buffer "*shell*"
  "The buffer to jump to when you hit the `boss' key
If the buffer does not exist it chooses a random buffer whose name 
does not begin with '*' or ' '"
  :group 'tetris
  :type 'string)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Variables for internal use
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar tetris-mode-map nil)
(defvar tetris-empty-line nil "the string that represents a line with all cells empty")
(defvar tetris-full-line-regexp nil "regexp to recognize a line with all cells full")

(defvar tetris-level-cutoff 10 "Completing this many rows bumps the level by one.")

(defvar tetris-board-start nil "The row that the playing area starts at
This gets filled in at startup, depending on the number
of displayed pieces")

(defconst tetris-buffer-name "*tetris*")

(defconst tetris-reserved-chars "-ljtzshox|"
  "Characters used by tetris that are not available for the background")

(defconst tetris-regular-header "Regular tetris\n"
  "A string used to label regular tetris, as opposed to the initial-fill game")

(defconst tetris-line-bonuses '(0 3 9 27 81)
  "The bonuses awarded for completing lines")

(defconst tetris-piece-names '("Line" "L" "Reverse L" "Z" "Reverse Z" "Square" "T")
  "Names of the initial piece types")

(defvar tetris-initial-pieces nil)

(defvar tetris-height tetris-default-height
  "Height of all tetris boards")

(defvar tetris-width tetris-default-width
  "Width of all tetris boards")

(defvar tetris-board-width nil "actual width of board measured in characters")

(defvar tetris-total 0
  "Used to keep total score in tetris, and to show when a game is in progress")

(defvar tetris-active nil
  "Used as a flag for whether tetris is active or not.
This is meant to be used globally for multiple games, if I ever add that 
enhancement. `tetris-data' is used for each buffer to flag if a game is
in progress or not.")

(defvar tetris-data nil
  "Buffer-local data used for tetris.
I didn't want to make too many variables buffer local.
an array:
0 is a list of pieces, with car being the current piece; 
1 is current location;
2 is the score;
3 is the level;
4 is the piece count;
5 is the line count;
6 is the timer;
Set to nil when a game is not in progress.")

(defvar tetrii-buffers nil
  "List of all live tetris buffers")
(defvar tetrii-window-configuration nil
  "tetrii window configuration, is nil during regular tetris game")


(make-variable-buffer-local 'tetris-data)

;;; 
;;; low-level accessor functions
;;;
(defmacro t-location (&optional newx)
  (if newx `(aset tetris-data 1 ,newx) `(aref tetris-data 1)))
(defmacro t-score (&optional newx)
  (if newx `(aset tetris-data 2 ,newx) `(aref tetris-data 2)))
(defmacro t-level (&optional newx)
  (if newx `(aset tetris-data 3 ,newx) `(aref tetris-data 3)))
(defmacro t-piece-count (&optional newx)
  (if newx `(aset tetris-data 4 ,newx) `(aref tetris-data 4)))
(defmacro t-line-count (&optional newx)
  (if newx `(aset tetris-data 5 ,newx) `(aref tetris-data 5)))
(defmacro t-timer (&optional newx)
  (if newx `(aset tetris-data 6 ,newx) `(aref tetris-data 6)))
(defmacro t-piece (&optional replace)
  "With no argument gets the current piece; with one replaces the current piece with REPLACE"
  (if replace 
	  `(let ((t-pieces (aref tetris-data 0)))
		 (setq t-pieces (cons ,replace (cdr t-pieces)))
		 (aset tetris-data 0 t-pieces)
		 nil)
	'(car (aref tetris-data 0))))

(defmacro t-next (&optional next)
  (if next 
	  `(aset tetris-data 0 (append (cdr (aref tetris-data 0)) (list ,next)))
	'(cdr (aref tetris-data 0))))

;;;
;;; higher level functions for accessing buffer data
;;;
(defun tetris-next () 
  "Sets and draws (if desired) the next pieces."
  (let ((piece-num (nth 5 (t-piece))))
    (setf (nth piece-num (tetris-counts)) (1+ (nth piece-num (tetris-counts)))))
  (t-next (nth (random (length tetris-initial-pieces)) tetris-initial-pieces))
  (when tetris-show-next
	(loop with erase = (t-piece)
		  with y-offset = -3
		  with x-offset = (1- (/ tetris-default-width 2))
		  for curr in (t-next)
		  do (tetris-draw-piece tetris-background-char erase (list x-offset y-offset))
		  (tetris-draw-piece nil curr (list x-offset y-offset))
		  (setq erase curr
				y-offset (- y-offset 4))))
  (t-piece))

(defun tetris-score (&rest add) 
  "Gets or increments or resets the score in this tetris buffer."
  (if add
      (if (numberp (car add))
		  (let ((total (apply '+ add)))
			(t-score (+ total (t-score)))
			(setq tetris-total (+ tetris-total total))
			)
		(t-score 0)
		)
	(t-score)))

(defun tetris-level (&optional inc) 
  "Gets or sets the level in this tetris buffer.
if INC is a number set level to it, otherwise if nonnil increment level."
  (if inc
	  (progn 
		(tetris-set-tick)
		(t-level (1+ (t-level))))
	(t-level)))

(defun tetris-counts (&optional reset)
  "Gets the number of each piece type that has been used so far."
  (if reset 
	  (t-piece-count (make-list (length tetris-initial-pieces) 0))
	(t-piece-count)))

(defun tetris-lines (&optional inc)
  "Accesses the number of lines completed in the tetris buffer.
INC is nil to report, nonnil to increment the number by 1."
  (if inc (t-line-count (+ (t-line-count) (if (numberp inc) inc 1)))
	(t-line-count)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Controls and setup
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun tetris (&optional width height fillin buffer)
  "Starts a tetris game in a buffer. 
Optionally sets custom board size WIDTH x HEIGHT. If FILLIN is set
it is a number of rows to start partially filled in. If BUFFER is
set it means TETRII has already initialized a buffer, a new one 
does not need to be made.

If a game is in progress, paused, and the buffer buried switch to the
buffer.  If there is no game or it has finished start a new one.

Alternatively, start with some cells randomly filled in with an `X',
and play until you lose or until all the `X's are gone, when you
win. Invoke the `tetris' function with a prefix argument n > 0 to fill
in the bottom n lines, or with prefix <= 0 to play regular tetris. See
the variables `tetris-initial-fill-rows' and `tetris-initial-fill-%',

SCORING: I am not sure how the scoring is supposed to work. It is 
paramaterized so it is easy to change if desired. The current system is:

 - Each orientation of each piece has an associated score ranging from 1 to 10
	This is given in the piece definition structure
 - A bonus is given if the piece is dropped of 1 point per level dropped
 - A bonus is given for completed lines, higher if more lines are completed 
	at once: 3, 9, 27, 81 for 1, 2, 3, 4 lines completed: see tetris-line-bonuses

tetris-mode keybindings:
   \\<tetris-mode-map>
Game control:
\\[tetris]	Set up a new game of Tetris
\\[tetris-go]	Start (or resume) the current game
\\[tetris-stop]	Pause the current game
\\[tetris-quit]	Quit the current game
\\[tetris-exit]	Exit tetris
\\[tetris-boss-key]	Pause the game and bury the buffer

In addition, using any command that does not start with 'tetris-' will
pause the game, so leaving the buffer will halt it.

Playing commands:
\\[tetris-move-left]	Moves the shape one square to the left
\\[tetris-move-right]	Moves the shape one square to the right
\\[tetris-clockwise]	Rotates the shape clockwise
\\[tetris-counter-clockwise]	Rotates the shape counterclockwise
\\[tetris-drop]	Drops the shape one space or to the bottom of the playing area

Other:
\\[tetris-report]	Give a breakdown on what pieces have been played so far
\\[tetris-show-high-scores]	Display the top scores
\\[tetris-help]	Display this help information

"
  (interactive)
  (if buffer nil
	(tetris-setup height width)
	(setq buffer tetris-buffer-name
		  tetrii-window-configuration nil
		  tetrii-buffers (list buffer)))
  (switch-to-buffer (get-buffer-create buffer))
  (erase-buffer)
; For some reason if this is in all tetrii boards come out identical
;    (random t)
  (setq tetris-total 0
		tetris-data (make-vector 8 nil))
  (t-score 0)
  (t-level (or tetris-initial-level 0))
  (t-line-count 0)
  (or (numberp tetris-show-next) (setq tetris-show-next (if tetris-show-next 1 0)))
  (tetris-piece-setup)
  (tetris-make-board (or fillin current-prefix-arg tetris-initial-fill-rows)
					 tetris-width tetris-height)
  (tetris-get-starting-pieces)
  (tetris-score t)
  (timer-set-function (t-timer (timer-create)) 'tetris-tick (list (buffer-name)))
  (tetris-level 0)
  buffer)

(defun tetris-setup (height width)
  (tetris-debug-setup)
  (setq tetris-width (or width tetris-default-width)
		tetris-height (or height tetris-default-height)
		tetrii-buffers nil)
;  (tetrii-setup-mouse)
  )

(defun tetrii (&optional count)
  "Play TETRII: tetris on multiple boards simultaneously. See documentation for TETRIS command
Most of the keys and commands are the same, but there are a few
additional ones. Mainly, the number keys are used to switch
buffers. And, currently it plays in unfilled mode, since to me working
on two or more partially filled boards seems difficult and not much
fun. But, this is emacs - you can change it if you don't like it.

There are a few different ways of playing. Using just the keyboard,
the keys 1, 2, 3... switch to the buffer *tetris-N*, so you can play
with one hand on the number keys and the other on the arrow keys, like
regular tetris.

Alternatively, if the tetrii-use-mouse option is chosen you can play
using the mouse. Left click is move left, right click is move right,
center is rotate, and space is still drop, but all take affect in the
buffer where the mouse pointer is currently located.


For this command, the prefix argument gives the number of boards to play."

  (interactive)
  (tetris-setup nil nil)
  (setq count (or count current-prefix-arg tetrii-default-number))
  (tetrii-define-buffer-keys count)
  (delete-other-windows)
  (setq tetrii-buffers (cons (tetris nil nil t "*tetris-1*")
							 (loop with width = (/ (window-width) count)
								   for i from 2 to count
								   do (split-window nil width t)
								   (select-window (next-window))
								   collect (tetris nil nil t (format "*tetris-%d*" i)))))
  (setq tetrii-window-configuration (current-window-configuration))
  )

(defun tetrii-kill-all ()
  (interactive)
  (delete-other-windows)
  (mapc 'kill-buffer tetrii-buffers)
  (setq tetrii-buffers nil)
  (select-window (previous-window)))

(defun tetrii-set-board (x)
  (select-window (get-buffer-window (nth x tetrii-buffers))))

(defun tetrii-make-switch-function (num undefined)
  (let ((symbol (intern (format "tetris-set-board-%d" num))))
	(setf (symbol-function symbol)
		  (if undefined 'undefined
			`(lambda () (interactive) (tetrii-set-board ,(1- num)))))
	(define-key tetris-mode-map (make-string 1 (+ ?0 num)) symbol)
	))

(defun tetrii-define-buffer-keys (x)
  (loop for i from 1 to 9
		do (tetrii-make-switch-function i (> i x))))


(defun tetrii-stats ()
  (cons (reduce '+ (mapcar (lambda (x) (with-current-buffer x (t-score))) tetrii-buffers))
		(reduce '+ (mapcar (lambda (x) (with-current-buffer x (t-line-count))) tetrii-buffers)))
  )

(defun tetrii-show-score () 
  (let ((stats (tetrii-stats)))
	(message (format "Total score is %d, total lines are %d" (car stats) (cdr stats)))))

(defun tetris-help ()
  "displays a help screen for tetris"
  (interactive)
  (tetris-stop)
  (describe-function 'tetris))

(defun tetris-go ()
  (interactive)
  (tetrii-restore-windows)
  (mapc 'tetris-go-one tetrii-buffers))

(defun tetris-go-one (buffer)
  "Starts up an inactive tetris game."
  (with-current-buffer buffer
	(when tetris-data
	  ;; Try to avoid this happening at awkward times
	  (garbage-collect)
	  (message "Starting Tetris")
	  (tetris-set-tick)
	  (timer-activate (t-timer))
	  (setq tetris-active t))))

(defun tetris-stop ()
  "stops all tetris games. Optional BUFFER is a buffer running tetris."
  (interactive)
  (when tetris-active
	(message "Stopping Tetris")
	(mapc 'tetris-stop-one tetrii-buffers))
	(cancel-function-timers 'tetris-tick)
	(setq tetris-active nil))

(defun tetris-stop-one (buffer)
  (with-current-buffer buffer
	;; Apparently the timer must be stopped first.
	(timer-set-time (t-timer) (current-time) nil)
	))

(defun tetris-quit ()
  "same as tetris-stop, but also zeros out the current game"
  (interactive)
  (tetris-stop)
  (setq tetris-total 0 tetris-data nil))

(defun tetris-exit ()
  "quits a game and exits the tetris buffer."
  (interactive)
  (tetris-quit)
  (tetrii-kill-all)
  )

(defun tetris-boss-key () 
  "Stops and switches buffers
Will go to a designated buffer, or a random buffer if there is
none designated or the designated one does not exist.

To restore change to any one of the tetrii buffers and type 'w'
"
  (interactive)
  (tetris-stop)
  (delete-other-windows)
  (switch-to-buffer (if (get-buffer tetris-boss-buffer) tetris-boss-buffer
					  ;; choose a random buffer that does not begin with ' ' or '*'
					  (let ((all (delete* nil (buffer-list) :test (lambda (a b) (string-match "^\\*\\|^ " (buffer-name (or a b)))))))
						(nth (random (length all)) all)))))

(defun tetrii-restore-windows ()
  "Restores the tetrii window configuration"
  (interactive)
  (if tetrii-window-configuration (set-window-configuration tetrii-window-configuration)))
  
(defun tetris-done (win)
  "Processes a finished tetris game."
  (tetris-stop)
  (mapc (lambda (x) (with-current-buffer x (tetris-report))) tetrii-buffers)
  (insert (if win "\n YOU WIN!!!\n" "\n game over\n\n")
	  (tetris-add-high-score win))
  (tetrii-show-score)
  (setq tetris-data nil tetris-total 0)
  )

(defun tetris-make-board (filled-rows width height)
  "Makes and displays a new tetris buffer"
  (setq filled-rows (cond ((numberp filled-rows) 
						   (if (> filled-rows 0) filled-rows nil))
						  ((not filled-rows) (and tetris-initial-fill-rows (> tetris-initial-fill-rows 0) tetris-initial-fill-rows))
						  (t nil)))
  (let* ((board-width (+ 2 tetris-board-width))
		 (row tetris-empty-line)
		 (border (concat (make-string board-width ?-) "\n")))
    (insert (if filled-rows (format "%s rows filled initially, %s percent\n" filled-rows tetris-initial-fill-%)
			  tetris-regular-header)
			;; Make the next-piece area
			border)
	(loop repeat tetris-show-next
		  do (insert row row row border)
		  )
    ;; and now the game board
    (tetris-make-playing-area height filled-rows row)
	(setq tetris-board-start (+ 3 (* 4 tetris-show-next)))
    (insert border
			"\nScore: Push `g' to go\n\n\nReport: ")
    (tetris-mode)
    (tetris-lines 0)
    (goto-char 0)
    ))

(defun tetris-make-playing-area (height filled-rows blank-row)
  "Makes the empty part of the tetris game board.
The board consists of this part and the preinitialized part, which is 
set up by `tetris-filled-row'."
  (or filled-rows (setq filled-rows 0))
  (loop repeat (- height filled-rows)
		do (insert blank-row))
  (loop	with empty = (make-string (if tetris-double-width 2 1) tetris-background-char)
		with filled = (if tetris-double-width "XX" "X")
		repeat filled-rows
		do (insert (tetris-filled-row filled empty))))

(defun tetris-filled-row (filled empty)
  "Makes the filled part of the tetris game board.
The board consists of this part and the blank part, which is 
set up by `tetris-make-playing-area'."
  (concat "|" (loop repeat tetris-width
					concat (if (< (random 100) tetris-initial-fill-%) filled empty))
		  "|\n"))

(defun tetris-mode ()
  "Sets up tetris mode for playing tetris"
  (use-local-map tetris-mode-map)
  (buffer-disable-undo)
  (setq mode-name "tetris"
	major-mode 'tetris-mode
	case-fold-search nil)
  (run-hooks 'tetris-mode-hook)
  )

(defun tetris-get-starting-pieces ()
  "Initializes the list of pieces, including the initial piece and all displayed upcoming pieces"
  (tetris-counts t)
  (aset tetris-data 0
		(loop with length = (length tetris-initial-pieces)
			  repeat (1+ (if tetris-show-next (if (numberp tetris-show-next) tetris-show-next 1) 0))
			  collect (nth (random length) tetris-initial-pieces))
		)
    (tetris-new-piece t)
	)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; dropping functions
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun tetris-set-tick (&optional secs) 
  "Sets the delay time for drops"
  (timer-set-time (t-timer) (current-time) 
		  (or secs (tetris-compute-tick (tetris-level)))))

(defun tetris-compute-tick (level) 
  "Computes the tick time (speed of descent) in tetris."
  (/ 2000.0 (+ 3 level) 1000))
(setq trace nil)

(defun tetris-tick (buffer) 
  "Moves the piece down by 1 when the timer expires."
  ;;; This is tricky... I want it to stop automatically when user goes
  ;;; to another buffer, but for a long time it has had a bug where it
  ;;; would intermittantly stop for no apparent reason. It used to
  ;;; check that the major mode was 'tetris-mode. It turns out that
  ;;; the buffer can be set by other background tasks - in my case,
  ;;; jit-lock was occasionally setting the buffer to something else,
  ;;; so when this was called the buffer would not be the same.
  ;;;
  ;;; This solution is almost as good. When playing, all commands
  ;;; begin with "tetris-", so confirm that the last command was a
  ;;; tetris command, and if not stop.
  (with-current-buffer buffer
;	(if locked (progn
;				 (cancel-timer (t-timer))
;				 (timer-activate (t-timer)))
;	  (setq locked t)
	  (setq trace (cons (list buffer "on") trace))
	  (if (string-match "^tetri.-" (symbol-name last-command))
		  (if (tetris-move-down) nil
			;; Following function is defined as a nop or a debugging function
			;; see comments for the function
			(tetris-debug-save-contents)
			(tetris-draw-piece (downcase (car (t-piece))))
			(tetris-score (fifth (t-piece)) (tetris-clean-lines))
			(tetris-show-score)
			(tetris-new-piece)
			(goto-char 1)
			(or (looking-at tetris-regular-header)
				(re-search-forward "X" nil t)
				(tetris-done t))
			)
		(tetris-stop)
;;; In case of strange halts uncomment this so it will break and you can
;;; see where it is coming from
;		(debug (list last-command last-command-event))
		)
;	  (setq locked nil)
;	  (setq trace (cons (list buffer "off") trace))
;	  )
	)
  )

(defun tetris-check (piece location) 
  "Checks if PIECE can be put into LOCATION."
  (if piece		; minor optimization: rotate square does nothing (see square definition)
	  (let* ((descriptor (second piece))
			 (current (car descriptor))
			 (good t)
			 x y length regexp)
		(tetris-goto location)
		(setq descriptor (cdr descriptor))
		(while current
		  (multiple-value-setq (x y length regexp) current)
		  (forward-char x)
		  (if tetris-double-width (forward-char x))
		  (next-line y)
		  (if (not (looking-at regexp))
			  (setq current nil good nil)
			(setq current (car descriptor)
				  descriptor (cdr descriptor))
			(forward-char length)
			))
		good)))

(defun tetris-new-piece (&optional init) 
  "Starts a new piece."
  (tetris-next)
  (if init (tetris-counts t))
  (if (tetris-check (t-piece)
					(t-location (list (1- (/ tetris-width 2)) 0)))
      (tetris-draw-piece)
    (tetris-done nil))
  )

(defun tetris-clean-lines ()
  "Removes completed lines and returns completion bonus."
  (goto-char 1)
  (let ((lines 0))
    (while (re-search-forward tetris-full-line-regexp nil t)
      (setq lines (1+ lines))
      (if (= (mod (tetris-lines t) tetris-level-cutoff) 0) (tetris-level t))
	  (delete-region (line-beginning-position) (1+ (line-end-position)))
      (goto-line tetris-board-start)
	  (insert tetris-empty-line))
	;; return the bonus (on the first rep if the board is prefilled
	;; it is possible for more than 4 lines to be completed)
    (or (nth lines tetris-line-bonuses) 243)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Movement functions
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun tetris-move-right ()
  "Moves the current piece to the right if possible."
  (interactive)
  ;; the hover check must only be done in interactive functions,
  ;; so it cannot be done in translate
  (if (and tetrii-use-mouse tetrii-window-configuration)
	  (set-buffer (tetrii-get-hover-window)))
  (tetris-translate 1))

(defun tetris-move-left ()
  "Moves the current piece to the left if possible."
  (interactive)
  (if (and tetrii-use-mouse tetrii-window-configuration)
	  (set-buffer (tetrii-get-hover-window)))
  (tetris-translate -1))

(defun tetris-move-down ()
  "Moves the current piece down if possible."
  (interactive)
  (tetris-translate 0))

(defun tetris-drop ()
  "drops a piece all the way to the bottom."
  (interactive)
  (if (and tetrii-use-mouse tetrii-window-configuration)
	  (set-buffer (tetrii-get-hover-window)))
  (if tetris-drop 
      (let ((bonus 0))
		(while (tetris-move-down) (setq bonus (1+ bonus)))
		(tetris-score bonus))
	(tetris-move-down)
	(tetris-score 1)))

(defun tetris-clockwise () 
  "Rotates the current piece clockwise, if possible."
  (interactive)
  (tetris-rotate t))

(defun tetris-counter-clockwise () 
  "Rotates the current piece counterclockwise, if possible."
  (interactive)
  (tetris-rotate nil))

(defun tetris-translate (delta)
  "Translates the current piece DELTA spaces right. If 0, moves down one line."
  (and tetris-active
       (let* ((location (t-location))
	      (new-x (+ (car location) delta))
	      (new-y (if (= delta 0) (1+ (second location)) (second location)))
	      (new-location (list new-x new-y)))
	 (when (tetris-check (t-piece) new-location)
	   (tetris-clear-piece)
	   (t-location new-location)
	   (tetris-draw-piece)
	   (goto-char 0)))))

(defun tetris-rotate (clockwise)
  "Rotates the current piece. CLOCKWISE t for clockwise, nil for counter."
  (if (and tetrii-use-mouse tetrii-window-configuration)
	  (set-buffer (tetrii-get-hover-window)))
  (and tetris-active
       (let* ((piece (t-piece))
			  (new-piece (symbol-value (if clockwise (third piece) (fourth piece))))
			  )
		 (when (tetris-check new-piece (t-location))
		   (tetris-clear-piece)
		   (t-piece new-piece)
		   (tetris-draw-piece)
		   (goto-char 0)))))

;;;
;;; tetrii handling functions
;;;

(defun tetrii-ignore () "ignore an event
IGNORE cannot be used because tetrii pauses on a command that does not
begin with tetri?-"
  (interactive))

(defun tetrii-get-hover-window ()
  "Gets the window the mouse is currently over
This uses the fact that all the windows are about the same size"
  (nth (/ (cadr (mouse-position)) (window-width)) tetrii-buffers))

(defun tetrii-mouse-right ()
  "Moves the active piece to the right in the current buffer
If TETRII-USE-MOUSE is nonnil this takes affect in the buffer where the
mouse pointer is located. Otherwise it is in the selected buffer."
  (interactive)
  ;; Take care if the mouse is clicked fast
  (loop repeat (case last-command-event
				 ((triple-down-mouse-3 triple-mouse-3) 3)
				 ((double-down-mouse-3 double-mouse-3) 2)
				 (t 1))
		do (tetris-move-right))
  )

(defun tetrii-mouse-left ()
  "Moves the active piece to the left in the current buffer
If TETRII-USE-MOUSE is nonnil this takes affect in the buffer where the
mouse pointer is located. Otherwise it is in the selected buffer."
  (interactive)
  (loop repeat (case last-command-event
				 ((triple-down-mouse-1 triple-mouse-1) 3)
				 ((double-down-mouse-1 double-mouse-1) 2)
				 (t 1))
		do (tetris-move-left))
  )

(defun tetrii-mouse-rotate (&optional clockwise)
  "Rotates the active piece in the current buffer
If TETRII-USE-MOUSE is nonnil this takes affect in the buffer where the
mouse pointer is located. Otherwise it is in the selected buffer."
  (interactive)
  (loop repeat (case last-command-event
				 ((triple-down-mouse-2 triple-mouse-2) 3)
				 ((double-down-mouse-2 double-mouse-2) 2)
				 (t 1))
		do (tetris-rotate clockwise)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Drawing functions
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun tetris-clear-piece ()
  "Erases the current piece in the tetris buffer"
  (tetris-draw-piece tetris-background-char))

(defun tetris-draw-piece (&optional char piece location)
  "Draws the current piece in the current location"
  (tetris-goto (or location (t-location)))
  (or piece (setq piece (t-piece)))
  (let* ((descriptor (second piece))
	 (current (car descriptor))
	 )
    (or char (setq char (car piece)))
    (setq descriptor (cdr descriptor))
    (while current
      (forward-char (car current))
      (if tetris-double-width (forward-char (car current)))
      (next-line (second current))
      (delete-char (third current))
      (insert-char char (third current))
      (setq current (car descriptor)
	    descriptor (cdr descriptor))
      ))
  t
  )

(defun tetris-goto (location)
  "Moves point to the given LOCATION (list of (X, Y))."
  (goto-line (+ tetris-board-start (second location)))
  (forward-char (1+ (car location)))
  (if tetris-double-width (forward-char (car location))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; scoring functions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun tetris-show-score ()
  (when (re-search-forward "^Score: " nil t)
	(tetrii-show-score)
	(delete-region (point) (line-end-position))
    (insert (format "%s   Lines: %s   Level: %s" 
		    (tetris-score) (tetris-lines) (tetris-level)))))

(defun tetris-report () 
  "Reports on the number of each type of piece that has been handled so far."
  (interactive)
  (when (re-search-forward "^Report: " nil t)
    (kill-line 3)
    (insert (format "Total pieces: %s\n        " (apply '+ (tetris-counts))))
    (mapcar* (lambda (count name) 
	       (insert name ": " (format "%s  " count))) 
	     (tetris-counts) tetris-piece-names)))

(defun tetris-add-high-score (win)
  "Checks the current score against the high score file and inserts it if high.
WIN is t if `tetris-initial-fill-rows' is nonnil and the game is won. It allows
any number of lines to preceed the scores, as long as none of them begin with a
number."
  (let ((score (tetris-score))
	(lines (tetris-lines))
	(buffer (current-buffer))
	(ret "")
	(count 0))
    (set-buffer (find-file-noselect tetris-score-file))
    (setq buffer-read-only nil)
    (goto-char 0)
    (while (and (looking-at "[^0-9]") (= 0 (forward-line))))
    (while (<= (setq count (1+ count)) tetris-high-scores-keep)
      (looking-at "[0-9]*")
      (if (< score (string-to-number (match-string 0)))
	  (forward-line 1)
	(setq ret (format "This is the number %s score!" count))
	(tetris-insert-score-data score lines win )
	(forward-line (- tetris-high-scores-keep count))
	(delete-region (point) (1+ (buffer-size)))
	(save-buffer)
	(setq count 11111)))
    (set-buffer buffer)
    ret))

(defun tetris-get-initial-filled () 
  (save-excursion 
	(set-buffer tetris-buffer-name)
	(goto-char 0)
	(if (looking-at "\\([0-9]+\\) rows")
		(match-string 1))))

(defun tetris-insert-score-data (score lines win)
  "makes and insert the high score entry in the tetris data file."
  (let ((filled (tetris-get-initial-filled)))
    (insert (number-to-string score) " " (number-to-string lines)
	    " by " user-login-name 
	    " on " (current-time-string) "  "
	    (if filled (concat (if win "WIN" "LOSE") " " filled) "")
	  "\n")
  ))

(defun tetris-bury-high-scores ()
  "Hides the tetris score window if it is showing"
  (interactive)
  (let ((buffer (find-buffer-visiting tetris-score-file)))
    (if buffer (delete-windows-on buffer))))

(defun tetris-show-high-scores ()
  "Displays the high score file."
  (interactive)
  (let ((selected-window (selected-window)))
    (find-file-other-window tetris-score-file)
    (setq buffer-read-only t)
    (select-window selected-window)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Setup data and keymap
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Redo setup whenever the game is started to track configuration changes
(defun tetris-piece-setup ()
  "Sets up the pieces for tetris.
Called on restart to make sure the `tetris-double-width' and 
`tetris-background-char track properly."

  (let ((tetris-background-string (make-string 1 tetris-background-char)))
	(if (string-match (regexp-quote tetris-background-string)
					  tetris-reserved-chars)
		(error "Bad value for `tetris-background-char' of `%s'" tetris-background-string))
	(setq tetris-board-width (if tetris-double-width (* 2 tetris-width) tetris-width)
		  tetris-empty-line (concat "|" (make-string tetris-board-width tetris-background-char) "|\n")
		  tetris-full-line-regexp (format "^|[^%c]+|$" tetris-background-char)))
  
  
;;; Each piece descriptor is a list giving the data needed to move, draw, and
;;; score a piece in a particular orientation. The format is:
;;;
;;; first element: the char used to draw the piece. It must be a capital
;;;        alphabetic, so the small version can be used to mark fallen pieces.
;;; second element: a list telling how to recognize the piece. Each element
;;;        describes a horizontal slice of the piece, and consists of 4 elements:
;;;        The x, y offset of the start of the slice from the piece location, the
;;;        length of the slice, and a RE that can be used to recognize that slice
;;; third element: symbol name of the piece descriptor to use for clockwise 
;;;        rotation
;;; fourth element: symbol name of the piece descriptor to use for 
;;;        counterclockwise rotation.
;;; fifth element: number of points to award when this piece alights in this
;;;        orientation
;;; sixth element: piece number (used for reporting)

  (flet ((width (x) (if tetris-double-width (* 2 x) x))
		 (make-REs (char)
						  "Generates the regexps needed to recognize each piece"
						  (let* ((one (format "[%c%c]" char tetris-background-char))
								 (two (concat one one))
								 (three (concat one two)))
							(if tetris-double-width 
								(list two (concat two two) (concat three three))
							  (list one two three)))))
	(let (a1 a2 a3)   ; don't allocate strings more than necessary
	  ;; horizontal line
	  (multiple-value-setq (a1 a2 a3) (make-REs ?O))
	  (setq a3 (concat a3 a1))			; make a special regexp of length 4
	  (setq tetris-h-line `(?O 
							((-1 0 ,(width 4) ,a3))
							tetris-v-line tetris-v-line 
							10
							0)
			tetris-v-line `(?O  
							((0 -1 ,(width 1) ,a1) (-1 1 ,(width 1) ,a1) (-1 1 ,(width 1) ,a1) (-1 1 ,(width 1) ,a1))
							tetris-h-line tetris-h-line
							1
							0))
	  ;; Z
	  (multiple-value-setq (a1 a2 a3) (make-REs ?Z))
	  (setq tetris-z `(?Z
					   ((-1 0 ,(width 2) ,a2) (-1 1 ,(width 2) ,a2))
					   tetris-z-90 tetris-z-90 
					   6
					   3)
			tetris-z-90 `(?Z
						  ((0 -1 ,(width 1) ,a1) (-2 1 ,(width 2) ,a2) (-2 1 ,(width 1) ,a1))
						  tetris-z tetris-z
						  4
						  3))
	  ;; reverse Z
	  (multiple-value-setq (a1 a2 a3) (make-REs ?S))
	  (setq tetris-rev-z `(?S
						   ((0 0 ,(width 2) ,a2) (-3 1 ,(width 2) ,a2))
						   tetris-rev-z-90 tetris-rev-z-90
						   6
						   4)
			tetris-rev-z-90 `(?S
							  ((0 -1 ,(width 1) ,a1) (-1 1 ,(width 2) ,a2) (-1 1 ,(width 1) ,a1))
							  tetris-rev-z tetris-rev-z
							  4
							  4))
	  ;; T
	  (multiple-value-setq (a1 a2 a3) (make-REs ?T))
	  (setq tetris-t `(?T
					   ((-1 0 ,(width 3) ,a3) (-2 1 ,(width 1) ,a1))
					   tetris-t-90 tetris-t-270
					   6
					   6)
			tetris-t-90 `(?T
						  ((0 -1 ,(width 1) ,a1) (-1 1 ,(width 2) ,a2) (-2 1 ,(width 1) ,a1))
						  tetris-t-180 tetris-t
						  3
						  6)
			tetris-t-180 `(?T
						   ((-1 0 ,(width 3) ,a3) (-2 -1 ,(width 1) ,a1))
						   tetris-t-270 tetris-t-90
						   6
						   6)
			tetris-t-270 `(?T
						   ((-1 0 ,(width 2) ,a2) (-1 -1 ,(width 1) ,a1) (-1 2 ,(width 1) ,a1))
						   tetris-t tetris-t-180
						   3
						   6))
	  ;; square
	  (multiple-value-setq (a1 a2 a3) (make-REs ?H))
	  (setq tetris-square `(?H
							((0 0 ,(width 2) ,a2) (-2 1 ,(width 2) ,a2))
							nil nil		;; these are left blank so it will fail rotation, since
							5			;; a rotated square is still a square
							5))
	  ;; L
	  (multiple-value-setq (a1 a2 a3) (make-REs ?L))
	  (setq tetris-l `(?L
					   ((0 -1 ,(width 1) ,a1) (-1 1 ,(width 1) ,a1) (-1 1 ,(width 2) ,a2))
					   tetris-l-90 tetris-l-270
					   4
					   1)
			tetris-l-90 `(?L
						  ((-1 0 ,(width 3) ,a3) (-1 -1 ,(width 1) ,a1))
						  tetris-l-180 tetris-l
						  7
						  1)
			tetris-l-180 `(?L
						   ((-1 -1 ,(width 2) ,a2) (-1 1 ,(width 1) ,a1) (-1 1 ,(width 1) ,a1))
						   tetris-l-270 tetris-l-90
						   3
						   1)
			tetris-l-270 `(?L
						   ((-1 1 ,(width 1) ,a1) (-1 -1 ,(width 3) ,a3))
						   tetris-l tetris-l-180
						   2
						   1))
	  ;; reverse L
	  (multiple-value-setq (a1 a2 a3) (make-REs ?J))
	  (setq tetris-rev-l `(?J
						   ((0 -1 ,(width 1) ,a1) (-1 1 ,(width 1) ,a1) (-2 1 ,(width 2) ,a2))
						   tetris-rev-l-90 tetris-rev-l-270
						   4
						   2)
			tetris-rev-l-90 `(?J
							  ((-1 0 ,(width 3) ,a3) (-1 1 ,(width 1) ,a1))
							  tetris-rev-l-180 tetris-rev-l
							  7
							  2)
			tetris-rev-l-180 `(?J
							   ((0 -1 ,(width 2) ,a2) (-2 1 ,(width 1) ,a1) (-1 1 ,(width 1) ,a1))
							   tetris-rev-l-270 tetris-rev-l-90
							   3
							   2)
			tetris-rev-l-270 `(?J
							   ((-1 -1 ,(width 1) ,a1) (-1 1 ,(width 3) ,a3))
							   tetris-rev-l tetris-rev-l-180
							   2
							   2))
	  )
	)
  (setq tetris-initial-pieces 		; the pieces to choose from 
		(list tetris-h-line tetris-l-270 tetris-rev-l-90 tetris-z tetris-rev-z tetris-square tetris-t))
  )

(setq tetris-mode-map (copy-keymap (current-global-map)))
(suppress-keymap tetris-mode-map t)
(define-key tetris-mode-map '[left] 'tetris-move-left)
(define-key tetris-mode-map '[up] 'tetris-clockwise)
(define-key tetris-mode-map '[down] 'tetris-counter-clockwise)
(define-key tetris-mode-map '[right] 'tetris-move-right)
(define-key tetris-mode-map " " 'tetris-drop)
(define-key tetris-mode-map "g" 'tetris-go)
(define-key tetris-mode-map "c" 'tetris-go)
(define-key tetris-mode-map "p" 'tetris-stop)
(define-key tetris-mode-map "q" 'tetris-quit)
(define-key tetris-mode-map "x" 'tetris-exit)
(define-key tetris-mode-map "w" 'tetrii-restore-windows)
(define-key tetris-mode-map "r" 'tetris-report)
(define-key tetris-mode-map "s" 'tetris-show-high-scores)
(define-key tetris-mode-map "b" 'tetris-bury-high-scores)
(define-key tetris-mode-map "n" 'tetris)
(define-key tetris-mode-map "z" 'tetris-boss-key)
(define-key tetris-mode-map "?" 'tetris-help)
(define-key tetris-mode-map "\C-m" 'tetris-report)

(define-key tetris-mode-map [mouse-1] 				'tetrii-mouse-left)
(define-key tetris-mode-map [double-mouse-1] 		'tetrii-mouse-left)
(define-key tetris-mode-map [triple-mouse-1] 		'tetrii-mouse-left)
(define-key tetris-mode-map [drag-mouse-1]			'tetrii-mouse-left)
(define-key tetris-mode-map [down-mouse-1] 			'tetrii-ignore)
(define-key tetris-mode-map [double-down-mouse-1] 	'tetrii-ignore)
(define-key tetris-mode-map [triple-down-mouse-1] 	'tetrii-ignore)

(define-key tetris-mode-map [mouse-3] 				'tetrii-mouse-right)
(define-key tetris-mode-map [double-mouse-3] 		'tetrii-mouse-right)
(define-key tetris-mode-map [triple-mouse-3] 		'tetrii-mouse-right)
(define-key tetris-mode-map [drag-mouse-3]			'tetrii-mouse-right)
(define-key tetris-mode-map [down-mouse-3] 			'tetrii-ignore)
(define-key tetris-mode-map [double-down-mouse-3] 	'tetrii-ignore)
(define-key tetris-mode-map [triple-down-mouse-3] 	'tetrii-ignore)

(define-key tetris-mode-map [mouse-2] 				'tetrii-mouse-rotate)
(define-key tetris-mode-map [double-mouse-2] 		'tetrii-mouse-rotate)
(define-key tetris-mode-map [triple-mouse-2] 		'tetrii-mouse-rotate)
(define-key tetris-mode-map [drag-mouse-2]			'tetrii-mouse-rotate)
(define-key tetris-mode-map [down-mouse-2] 			'tetrii-ignore)
(define-key tetris-mode-map [double-down-mouse-2] 	'tetrii-ignore)
(define-key tetris-mode-map [triple-down-mouse-2] 	'tetrii-ignore)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Debugging
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; I *think* it works, but there are times it seems to surprise me
;;; when a line disappears. Activate this to keep a record of previous
;;; positions, which you can then jump through by using
;;; TETRIS-DEBUG-NEXT and TETRIS-DEBUG-PREV
;;;
;;; followup note: so far the several times I ran it with this and
;;; checked it was right in every case, so I don't think there is a
;;; problem.

(defvar tetris-debug-buffer-count nil
  "Sets the number of buffers to use in the ring of debug buffers.
An integer gives the number of buffers to use, non-integer means 
no debugging for tetris")
;(setq tetris-debug-buffer-count nil)

(defvar tetris-debug-map nil
  "keymap used in tetris debugging buffers")

(defun tetris-debug-kill-existing ()
  "dummy")
(defun tetris-debug-move (x)
  "dummy")

(defun tetris-debug-off ()
  "Turns off debugging in the tetris game
See comments for tetris-debug-on"
  (tetris-debug-kill-existing)
  (defun tetris-debug-setup ())
  (defun tetris-debug-save-contents ()
	"This function is used as a switch to turn debugging on or off for tetris
The current value is on; in this case it is defined to save the 
tetris board in the current debug ring buffer. When debugging
is turned off it is redefined to do nothing."
	(if (numberp tetris-debug-buffer-count)
		(tetris-debug-on)))
  )
  
(defvar tetris-debug-current-buffer nil)
(defvar tetris-debug-shown-buffer nil)
(defvar tetris-debug-next-buffer nil)
(defvar tetris-debug-prev-buffer nil)
(make-variable-buffer-local 'tetris-debug-next-buffer)
(make-variable-buffer-local 'tetris-debug-prev-buffer)

(defun tetris-debug-on ()
  "turns on debugging in the tetris game.
This uses the function tetris-debug-save-contents as a switch. When
on it saves the contents in the current ring buffer, when off it is
defined as a nop. The first time called defines all the functions,
afterwards just sets up tetris-debug-save-contents."
  (defun tetris-debug-save-contents ()
	;; copies the current position into the next ring buffer and
	;; updates the current pointer
	(let ((contents (buffer-substring (point-min) (point-max))))
	  (with-current-buffer tetris-debug-current-buffer
		(erase-buffer)
		(insert contents)
		(setq tetris-debug-current-buffer tetris-debug-next-buffer
			  tetris-debug-shown-buffer nil))))

  (if tetris-debug-map ()
	(load "cl-macs")
	(setq tetris-debug-map (make-keymap))
	
	(define-key tetris-mode-map '[M-right] 'tetris-debug-next)
	(define-key tetris-mode-map '[M-left] 'tetris-debug-prev)

	(define-key tetris-debug-map '[M-right] 'tetris-debug-next)
	(define-key tetris-debug-map '[M-left] 'tetris-debug-prev)
	(define-key tetris-debug-map '[M-up] 'tetris-debug-newest)
	(define-key tetris-debug-map '[M-down] 'tetris-debug-oldest)
	(define-key tetris-debug-map "\C-m" 'tetris-debug-return)
	
	(defun tetris-debug-kill-existing ()
	  ;; kill all existing tetris-debug buffers
	  (let ((next tetris-debug-current-buffer))
		(while (buffer-live-p next)
		  (set-buffer next)
		  (setq next tetris-debug-next-buffer)
		  (kill-buffer (current-buffer))))
	  (setq tetris-debug-current-buffer nil))
	
	(defun tetris-debug-setup ()
	  ;; sets up the debugging environment: build a doubly linked list of
	  ;; buffers that can be used to replay part of a game
	  (tetris-debug-kill-existing)
	  (let ((which 0)
			curr prev)
		(dotimes (x tetris-debug-buffer-count)
		  (set-buffer (setq curr (get-buffer-create (format " *tetris-debug-%d*" which))))
		  (use-local-map tetris-debug-map)
		  (or tetris-debug-current-buffer (setq tetris-debug-current-buffer curr))
		  (when prev
			(setq tetris-debug-prev-buffer prev)
			(set-buffer prev)
			(setq tetris-debug-next-buffer curr)
			)
		  (setq prev curr
				which (1+ which)))
		(set-buffer curr)
		(setq tetris-debug-next-buffer tetris-debug-current-buffer)
		(set-buffer tetris-debug-current-buffer)
		(setq tetris-debug-prev-buffer curr)))
	
	(defun tetris-debug-move (command)
	  ;; moves to the next, previous, or a given buffer
	  (interactive "nJump to buffer: ")
	  (if (numberp command)
		  (switch-to-buffer (format " *tetris-debug-%d*" command))
		(set-buffer (or tetris-debug-shown-buffer tetris-debug-current-buffer))
		(if tetris-debug-shown-buffer
			(switch-to-buffer (if command tetris-debug-next-buffer tetris-debug-prev-buffer))
		  ;; if none currently shown then go to the last one written
		  (set-buffer tetris-debug-current-buffer)
		  (switch-to-buffer tetris-debug-prev-buffer)))
	  (setq tetris-debug-shown-buffer (current-buffer)))
	
	(defun tetris-debug-next()
	  "Moves to the next stored buffer for debugging tetris"
	  (interactive)
	  (tetris-debug-move t)
	  (if (equal (current-buffer) tetris-debug-current-buffer)
		  (message "Jumped to start of ring")))
	
	(defun tetris-debug-prev()
	  "Moves to the previous stored buffer for debugging tetris"
	  (interactive)
	  (let ((end (equal (current-buffer) tetris-debug-current-buffer)))
		(tetris-debug-move nil)
		(if end (message "Jumped to end of ring"))))

	(defun tetris-debug-newest ()
	  "Moves to the newest stored buffer for debugging tetris"
	  (interactive)
	  (set-buffer tetris-debug-current-buffer)
	  (switch-to-buffer tetris-debug-prev-buffer)
	  (message "Last recorded"))
	
	(defun tetris-debug-oldest ()
	  "Moves to the oldest stored buffer for debugging tetris"
	  (interactive)
	  (switch-to-buffer tetris-debug-current-buffer)
	  (if (= 1 (point-max))
		  (tetris-debug-move 0))
	  (message "Earliest recorded"))
	
	(defun tetris-debug-return ()
	  "Goes back to the tetris game from the tetris debug buffers"
	  (interactive)
	  (switch-to-buffer tetris-buffer-name))
	)
  )

;;; This sets up the function tetris-debug-save-contents as a switch
;;; to turn debugging on
(if (numberp tetris-debug-buffer-count)
	(tetris-debug-on)
  (tetris-debug-off)
  (defun tetris-debug-save-contents ()
	"This function is used as a switch to turn debugging on or off for tetris
The current value is off; in this case it does nothing. When debugging
is turned on it is redefined to save the tetris board in the current
debug ring buffer"
	(if (numberp tetris-debug-buffer-count)
		(tetris-debug-on)))
  )

(provide 'tetris)