* patch for tetris.el
@ 2010-04-18 22:33 lukas huonker
0 siblings, 0 replies; only message in thread
From: lukas huonker @ 2010-04-18 22:33 UTC (permalink / raw)
To: emacs-devel
[-- Attachment #1.1: Type: text/plain, Size: 259 bytes --]
hello
attached is a small patch that improves on the OO-features of tetris.el. it
allows pieces to be rotated in arbitrary ways, giving rotation a more
natural look and feel. also the initial rotations of pieces are different
from the last version.
lukas h
[-- Attachment #1.2: Type: text/html, Size: 281 bytes --]
[-- Attachment #2: tetris.patch --]
[-- Type: application/octet-stream, Size: 9677 bytes --]
--- tetris.el 2010-04-18 22:55:44.000000000 +0200
+++ tetris.el 2010-04-18 23:29:46.000000000 +0200
@@ -1,7 +1,7 @@
;;; tetris.el --- implementation of Tetris for Emacs
-;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Version: 2.01
@@ -196,40 +196,31 @@ Element 0 is ignored."
;; ;;;;;;;;;;;;; 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]]]
+
+ [[[1 0] [2 0] [1 1] [1 2]]
+ [[0 0] [0 1] [1 1] [2 1]]
+ [[1 0] [1 1] [0 2] [1 2]]
+ [[0 1] [1 1] [2 1] [2 2]]]
+
+ [[[1 0] [1 1] [1 2] [2 2]]
+ [[0 1] [1 1] [2 1] [2 0]]
+ [[0 0] [1 0] [1 1] [1 2]]
+ [[0 1] [1 1] [2 1] [0 2]]]
+
+ [[[1 0] [0 1] [1 1] [0 2]]
+ [[0 0] [1 0] [1 1] [2 1]]]
+
+ [[[0 0] [0 1] [1 1] [1 2]]
+ [[1 0] [2 0] [0 1] [1 1]]]
+
+ [[[0 1] [1 1] [2 1] [1 2]]
+ [[1 0] [1 1] [2 1] [1 2]]
+ [[0 1] [1 1] [2 1] [1 0]]
+ [[0 1] [1 0] [1 1] [1 2]]]
+
+ [[[1 0] [1 1] [1 2] [1 3]]
+ [[0 1] [1 1] [2 1] [3 1]]]])
;;the scoring rules were taken from "xtetris". Blocks score differently
;;depending on their rotation
@@ -237,9 +228,6 @@ Element 0 is ignored."
(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]] )
-(defconst tetris-shape-dimensions
- [[2 2] [3 2] [3 2] [3 2] [3 2] [3 2] [4 1]])
-
(defconst tetris-blank 0)
(defconst tetris-border 8)
@@ -320,20 +308,13 @@ Element 0 is ignored."
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-shape-width ()
- (aref (aref tetris-shape-dimensions tetris-shape)
- (% tetris-rot 2)))
-
-(defun tetris-shape-height ()
- (aref (aref tetris-shape-dimensions tetris-shape)
- (- 1 (% tetris-rot 2))))
+(defun tetris-get-shape-cell (block)
+ (aref (aref (aref tetris-shapes
+ tetris-shape) tetris-rot)
+ block))
+
+(defun tetris-get-shape-rotations ()
+ (length (aref tetris-shapes tetris-shape)))
(defun tetris-draw-score ()
(let ((strings (vector (format "Shapes: %05d" tetris-n-shapes)
@@ -356,7 +337,7 @@ Element 0 is ignored."
(setq tetris-shape tetris-next-shape)
(setq tetris-rot 0)
(setq tetris-next-shape (random 7))
- (setq tetris-pos-x (/ (- tetris-width (tetris-shape-width)) 2))
+ (setq tetris-pos-x (- (/ tetris-width 2) 1))
(setq tetris-pos-y 0)
(if (tetris-test-shape)
(tetris-end-game)
@@ -365,52 +346,58 @@ Element 0 is ignored."
(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)
+ 0)))
+ (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))
+ (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))
+ (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)
@@ -523,7 +510,7 @@ Drops the shape one square, testing for
(defun tetris-move-left ()
"Moves the shape one square to the left"
(interactive)
- (unless (or (= tetris-pos-x 0)
+ (unless (or (< tetris-pos-x 0)
tetris-paused)
(tetris-erase-shape)
(setq tetris-pos-x (1- tetris-pos-x))
@@ -534,8 +521,7 @@ Drops the shape one square, testing for
(defun tetris-move-right ()
"Moves the shape one square to the right"
(interactive)
- (unless (or (= (+ tetris-pos-x (tetris-shape-width))
- tetris-width)
+ (unless (or (= tetris-pos-x tetris-width)
tetris-paused)
(tetris-erase-shape)
(setq tetris-pos-x (1+ tetris-pos-x))
@@ -548,9 +534,9 @@ Drops the shape one square, testing for
(interactive)
(if (not tetris-paused)
(progn (tetris-erase-shape)
- (setq tetris-rot (% (+ 1 tetris-rot) 4))
+ (setq tetris-rot (% (+ 1 tetris-rot) (tetris-get-shape-rotations)))
(if (tetris-test-shape)
- (setq tetris-rot (% (+ 3 tetris-rot) 4)))
+ (setq tetris-rot (% (+ 3 tetris-rot) (tetris-get-shape-rotations))))
(tetris-draw-shape))))
(defun tetris-rotate-next ()
@@ -559,9 +545,11 @@ Drops the shape one square, testing for
(if (not tetris-paused)
(progn
(tetris-erase-shape)
- (setq tetris-rot (% (+ 3 tetris-rot) 4))
+ (setq tetris-rot (% (+ 3 tetris-rot)
+ (tetris-get-shape-rotations)))
(if (tetris-test-shape)
- (setq tetris-rot (% (+ 1 tetris-rot) 4)))
+ (setq tetris-rot (% (+ 1 tetris-rot)
+ (tetris-get-shape-rotations))))
(tetris-draw-shape))))
(defun tetris-end-game ()
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2010-04-18 22:33 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2010-04-18 22:33 patch for tetris.el lukas huonker
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).