;;; pong.el --- classical implementation of pong
-;; Copyright 1999, 2000, 2001 by Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Benjamin Drieu <bdrieu@april.org>
;; Keywords: games
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Customization
-(defgroup pong nil
+(defgroup pong nil
"Emacs-Lisp implementation of the classical game pong."
:tag "Pong"
:group 'games)
-(defcustom pong-buffer-name "*Pong*"
- "*Name of the buffer used to play."
+(defcustom pong-buffer-name "*Pong*"
+ "Name of the buffer used to play."
:group 'pong
:type '(string))
(defcustom pong-width 50
- "*Width of the playfield."
+ "Width of the playfield."
:group 'pong
:type '(integer))
(defcustom pong-height (min 30 (- (frame-height) 6))
- "*Height of the playfield."
+ "Height of the playfield."
:group 'pong
:type '(integer))
(defcustom pong-bat-width 3
- "*Width of the bats for pong."
+ "Width of the bats for pong."
:group 'pong
:type '(integer))
(defcustom pong-blank-color "black"
- "*Color used for background."
+ "Color used for background."
:group 'pong
:type 'color)
(defcustom pong-bat-color "yellow"
- "*Color used for bats."
+ "Color used for bats."
:group 'pong
:type 'color)
(defcustom pong-ball-color "red"
- "*Color used for the ball."
+ "Color used for the ball."
:group 'pong
:type 'color)
(defcustom pong-border-color "white"
- "*Color used for pong borders."
+ "Color used for pong borders."
:group 'pong
:type 'color)
(defcustom pong-left-key "4"
- "*Alternate key to press for bat 1 to go up (primary one is [left])."
+ "Alternate key to press for bat 1 to go up (primary one is [left])."
:group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-right-key "6"
- "*Alternate key to press for bat 1 to go down (primary one is [right])."
+ "Alternate key to press for bat 1 to go down (primary one is [right])."
:group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-up-key "8"
- "*Alternate key to press for bat 2 to go up (primary one is [up])."
+ "Alternate key to press for bat 2 to go up (primary one is [up])."
:group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-down-key "2"
- "*Alternate key to press for bat 2 to go down (primary one is [down])."
+ "Alternate key to press for bat 2 to go down (primary one is [down])."
:group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-quit-key "q"
- "*Key to press to quit pong."
+ "Key to press to quit pong."
:group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-resume-key "p"
- "*Key to press to resume pong."
+ "Key to press to resume pong."
:group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-timer-delay 0.1
- "*Time to wait between every cycle."
+ "Time to wait between every cycle."
:group 'pong
:type 'number)
(gamegrid-init-buffer pong-width
(+ 2 pong-height)
- 1)
+ ?\s)
(let ((buffer-read-only nil))
(loop for y from 0 to (1- pong-height) do
(gamegrid-set-cell x (1- y) pong-blank))
(if (< (+ y pong-bat-width) (1- pong-height))
(gamegrid-set-cell x (+ y pong-bat-width) pong-blank)))))
-
+
(defun pong-init ()
"Initialize a game."
-
+
(define-key pong-mode-map pong-pause-key 'pong-pause)
(add-hook 'kill-buffer-hook 'pong-quit nil t)
detection and checks if a player scores."
(if (not (eq (current-buffer) pong-buffer))
(pong-pause)
-
+
(let ((old-x pong-x)
(old-y pong-y))
-
+
(setq pong-x (+ pong-x pong-xx))
(setq pong-y (+ pong-y pong-yy))
-
+
(if (and (> old-y 0)
(< old-y (- pong-height 1)))
(gamegrid-set-cell old-x old-y pong-blank))
-
+
(if (and (> pong-y 0)
(< pong-y (- pong-height 1)))
(gamegrid-set-cell pong-x pong-y pong-ball))
-
+
(cond
((or (= pong-x 3) (= pong-x 2))
- (if (and (>= pong-y pong-bat-player1)
+ (if (and (>= pong-y pong-bat-player1)
(< pong-y (+ pong-bat-player1 pong-bat-width)))
- (and
+ (and
(setq pong-yy (+ pong-yy
- (cond
+ (cond
((= pong-y pong-bat-player1) -1)
((= pong-y (1+ pong-bat-player1)) 0)
(t 1))))
(setq pong-xx (- pong-xx)))))
((or (= pong-x (- pong-width 4)) (= pong-x (- pong-width 3)))
- (if (and (>= pong-y pong-bat-player2)
+ (if (and (>= pong-y pong-bat-player2)
(< pong-y (+ pong-bat-player2 pong-bat-width)))
- (and
+ (and
(setq pong-yy (+ pong-yy
- (cond
+ (cond
((= pong-y pong-bat-player2) -1)
((= pong-y (1+ pong-bat-player2)) 0)
(t 1))))
(setq pong-xx (- pong-xx)))))
-
+
((<= pong-y 1)
(setq pong-yy (- pong-yy)))
(provide 'pong)
+;; arch-tag: 1fdf0fc5-13e2-4de4-aae4-09bdd5af99f3
;;; pong.el ends here