[bpt/emacs.git] / lisp / play / pong.el

;;; pong.el --- classical implementation of pong

;; Copyright (C) 1999-2011  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
;; it under the terms of the GNU General Public License as published by
;; 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This is an implementation of the classical game pong.

;;; Code:

(eval-when-compile (require 'cl))

(require 'gamegrid)

;;; Customization

(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."
  :group 'pong
  :type '(string))

(defcustom pong-width 50
  "Width of the playfield."
  :group 'pong
  :type '(integer))

(defcustom pong-height (min 30 (- (frame-height) 6))
  "Height of the playfield."
  :group 'pong
  :type '(integer))

(defcustom pong-bat-width 3
  "Width of the bats for pong."
  :group 'pong
  :type '(integer))

(defcustom pong-blank-color "black"
  "Color used for background."
  :group 'pong
  :type 'color)

(defcustom pong-bat-color "yellow"
  "Color used for bats."
  :group 'pong
  :type 'color)

(defcustom pong-ball-color "red"
  "Color used for the ball."
  :group 'pong
  :type 'color)

(defcustom pong-border-color "white"
  "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])."
  :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])."
  :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])."
  :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])."
  :group 'pong
  :type '(restricted-sexp :match-alternatives (stringp vectorp)))

(defcustom pong-quit-key "q"
  "Key to press to quit pong."
  :group 'pong
  :type '(restricted-sexp :match-alternatives (stringp vectorp)))

(defcustom pong-pause-key "p"
  "Key to press to pause pong."
  :group 'pong
  :type '(restricted-sexp :match-alternatives (stringp vectorp)))

(defcustom pong-resume-key "p"
  "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."
  :group 'pong
  :type 'number)


;;; This is black magic.  Define colors used

(defvar pong-blank-options
  '(((glyph colorize)
     (t ?\040))
    ((color-x color-x)
     (mono-x grid-x)
     (color-tty color-tty))
    (((glyph color-x) [0 0 0])
     (color-tty pong-blank-color))))

(defvar pong-bat-options
  '(((glyph colorize)
     (emacs-tty ?O)
     (t ?\040))
    ((color-x color-x)
     (mono-x mono-x)
     (color-tty color-tty)
     (mono-tty mono-tty))
    (((glyph color-x) [1 1 0])
     (color-tty pong-bat-color))))

(defvar pong-ball-options
  '(((glyph colorize)
     (t ?\*))
    ((color-x color-x)
     (mono-x grid-x)
     (color-tty color-tty))
    (((glyph color-x) [1 0 0])
     (color-tty pong-ball-color))))

(defvar pong-border-options
  '(((glyph colorize)
     (t ?\+))
    ((color-x color-x)
     (mono-x grid-x)
     (color-tty color-tty))
    (((glyph color-x) [0.5 0.5 0.5])
     (color-tty pong-border-color))))

(defconst pong-blank	0)
(defconst pong-bat	1)
(defconst pong-ball	2)
(defconst pong-border	3)


;;; Determine initial positions for bats and ball

(defvar pong-xx nil
  "Horizontal speed of the ball.")

(defvar pong-yy nil
  "Vertical speed of the ball.")

(defvar pong-x nil
  "Horizontal position of the ball.")

(defvar pong-y nil
  "Vertical position of the ball.")

(defvar pong-bat-player1 nil
  "Vertical position of bat 1.")

(defvar pong-bat-player2 nil
  "Vertical position of bat 2.")

(defvar pong-score-player1 nil)
(defvar pong-score-player2 nil)

;;; Initialize maps

(defvar pong-mode-map
  (make-sparse-keymap 'pong-mode-map) "Modemap for pong-mode.")

(defvar pong-null-map
  (make-sparse-keymap 'pong-null-map) "Null map for pong-mode.")

(define-key pong-mode-map [left]	 'pong-move-left)
(define-key pong-mode-map [right] 	 'pong-move-right)
(define-key pong-mode-map [up]		 'pong-move-up)
(define-key pong-mode-map [down]	 'pong-move-down)
(define-key pong-mode-map pong-left-key  'pong-move-left)
(define-key pong-mode-map pong-right-key 'pong-move-right)
(define-key pong-mode-map pong-up-key	 'pong-move-up)
(define-key pong-mode-map pong-down-key  'pong-move-down)
(define-key pong-mode-map pong-quit-key  'pong-quit)
(define-key pong-mode-map pong-pause-key 'pong-pause)


;;; Fun stuff -- The code

(defun pong-display-options ()
  "Computes display options (required by gamegrid for colors)."
  (let ((options (make-vector 256 nil)))
    (loop for c from 0 to 255 do
      (aset options c
	    (cond ((= c pong-blank)
		   pong-blank-options)
                  ((= c pong-bat)
		   pong-bat-options)
                  ((= c pong-ball)
		   pong-ball-options)
                  ((= c pong-border)
		   pong-border-options)
                  (t
		   '(nil nil nil)))))
    options))


(defun pong-init-buffer ()
  "Initialize pong buffer and draw stuff thanks to gamegrid library."
  (interactive)
  (get-buffer-create pong-buffer-name)
  (switch-to-buffer pong-buffer-name)
  (use-local-map pong-mode-map)

  (setq gamegrid-use-glyphs t)
  (setq gamegrid-use-color t)
  (gamegrid-init (pong-display-options))

  (gamegrid-init-buffer pong-width
			(+ 2 pong-height)
			?\s)

  (let ((buffer-read-only nil))
    (loop for y from 0 to (1- pong-height) do
	  (loop for x from 0 to (1- pong-width) do
		(gamegrid-set-cell x y pong-border)))
    (loop for y from 1 to (- pong-height 2) do
	  (loop for x from 1 to (- pong-width 2) do
		(gamegrid-set-cell x y pong-blank))))

  (loop for y from pong-bat-player1 to (1- (+ pong-bat-player1 pong-bat-width)) do
	(gamegrid-set-cell 2 y pong-bat))
  (loop for y from pong-bat-player2 to (1- (+ pong-bat-player2 pong-bat-width)) do
	(gamegrid-set-cell (- pong-width 3) y pong-bat)))


(defun pong-move-left ()
  "Move bat 2 up.
This is called left for historical reasons, since in some pong
implementations you move with left/right paddle."
  (interactive)
  (if (> pong-bat-player1 1)
      (and
       (setq pong-bat-player1 (1- pong-bat-player1))
       (pong-update-bat 2 pong-bat-player1))))


(defun pong-move-right ()
  "Move bat 2 up."
  (interactive)
  (if (< (+ pong-bat-player1 pong-bat-width) (1- pong-height))
      (and
       (setq pong-bat-player1 (1+ pong-bat-player1))
       (pong-update-bat 2 pong-bat-player1))))


(defun pong-move-up ()
  "Move bat 2 up."
  (interactive)
  (if (> pong-bat-player2 1)
      (and
       (setq pong-bat-player2 (1- pong-bat-player2))
       (pong-update-bat (- pong-width 3) pong-bat-player2))))


(defun pong-move-down ()
  "Move bat 2 down."
  (interactive)
  (if (< (+ pong-bat-player2 pong-bat-width) (1- pong-height))
      (and
       (setq pong-bat-player2 (1+ pong-bat-player2))
       (pong-update-bat (- pong-width 3) pong-bat-player2))))


(defun pong-update-bat (x y)
  "Move a bat (suppress a cell and draw another one on the other side)."

  (cond
   ((string-equal (buffer-name (current-buffer)) pong-buffer-name)
    (gamegrid-set-cell x y pong-bat)
    (gamegrid-set-cell x (1- (+ y pong-bat-width)) pong-bat)
    (if (> y 1)
	(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)

  ;; Initialization of some variables
  (setq pong-bat-player1 (1+ (/ (- pong-height pong-bat-width) 2)))
  (setq pong-bat-player2 pong-bat-player1)
  (setq pong-xx -1)
  (setq pong-yy 0)
  (setq pong-x (/ pong-width 2))
  (setq pong-y (/ pong-height 2))

  (pong-init-buffer)
  (gamegrid-kill-timer)
  (gamegrid-start-timer pong-timer-delay 'pong-update-game)
  (pong-update-score))


(defun pong-update-game (pong-buffer)
  "\"Main\" function for pong.
It is called every pong-cycle-delay seconds and
updates ball and bats positions.  It is responsible of collision
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)
		 (< pong-y (+ pong-bat-player1 pong-bat-width)))
	    (and
	     (setq pong-yy (+ pong-yy
			      (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)
		 (< pong-y (+ pong-bat-player2 pong-bat-width)))
	    (and
	     (setq pong-yy (+ pong-yy
			      (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)))

       ((>= pong-y (- pong-height 2))
	(setq pong-yy (- pong-yy)))

       ((< pong-x 1)
	(setq pong-score-player2 (1+ pong-score-player2))
	(pong-init))

       ((>= pong-x (- pong-width 1))
	(setq pong-score-player1 (1+ pong-score-player1))
	(pong-init))))))


(defun pong-update-score ()
  "Update score and print it on bottom of the game grid."
  (let* ((string (format "Score:  %d / %d" pong-score-player1 pong-score-player2))
	 (len (length string)))
    (loop for x from 0 to (1- len) do
	  (if (string-equal (buffer-name (current-buffer)) pong-buffer-name)
	      (gamegrid-set-cell x
				 pong-height
				 (aref string x))))))


(defun pong-pause ()
  "Pause the game."
  (interactive)
  (gamegrid-kill-timer)
  ;; Oooohhh ugly.  I don't know why, gamegrid-kill-timer don't do the
  ;; jobs it is made for.  So I have to do it "by hand".  Anyway, next
  ;; line is harmless.
  (cancel-function-timers 'pong-update-game)
  (define-key pong-mode-map pong-resume-key 'pong-resume))


(defun pong-resume ()
  "Resume a paused game."
  (interactive)
  (define-key pong-mode-map pong-pause-key 'pong-pause)
  (gamegrid-start-timer pong-timer-delay 'pong-update-game))


(defun pong-quit ()
  "Quit the game and kill the pong buffer."
  (interactive)
  (gamegrid-kill-timer)
  ;; Be sure not to draw things in another buffer and wait for some
  ;; time.
  (run-with-timer pong-timer-delay nil 'kill-buffer pong-buffer-name))


;;;###autoload
(defun pong ()
  "Play pong and waste time.
This is an implementation of the classical game pong.
Move left and right bats and try to bounce the ball to your opponent.

pong-mode keybindings:\\<pong-mode-map>

\\{pong-mode-map}"
  (interactive)
  (setq pong-score-player1 0)
  (setq pong-score-player2 0)
  (pong-init))


(provide 'pong)

;;; pong.el ends here
Commit	Line	Data
5f72adc0	1	;;; pong.el --- classical implementation of pong
c1475eae	2
73b0cd50	3	;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
c1475eae	4
9781053a	5	;; Author: Benjamin Drieu <bdrieu@april.org>
c1475eae GM	6	;; Keywords: games
	7
	8	;; This file is part of GNU Emacs.
	9
b1fc2b50	10	;; GNU Emacs is free software: you can redistribute it and/or modify
c1475eae	11	;; it under the terms of the GNU General Public License as published by
b1fc2b50 GM	12	;; the Free Software Foundation, either version 3 of the License, or
b1fc2b50 GM	13	;; (at your option) any later version.
c1475eae GM	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
b1fc2b50	21	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
c1475eae GM	22
	23	;;; Commentary:
	24
	25	;; This is an implementation of the classical game pong.
	26
	27	;;; Code:
	28
	29	(eval-when-compile (require 'cl))
	30
	31	(require 'gamegrid)
	32
	33	;;; Customization
	34
a1506d29	35	(defgroup pong nil
c1475eae GM	36	"Emacs-Lisp implementation of the classical game pong."
	37	:tag "Pong"
	38	:group 'games)
	39
a1506d29	40	(defcustom pong-buffer-name "Pong"
67d110f1	41	"Name of the buffer used to play."
c1475eae GM	42	:group 'pong
	43	:type '(string))
	44
	45	(defcustom pong-width 50
67d110f1	46	"Width of the playfield."
c1475eae GM	47	:group 'pong
	48	:type '(integer))
	49
e029dcaf	50	(defcustom pong-height (min 30 (- (frame-height) 6))
67d110f1	51	"Height of the playfield."
c1475eae GM	52	:group 'pong
	53	:type '(integer))
	54
	55	(defcustom pong-bat-width 3
67d110f1	56	"Width of the bats for pong."
c1475eae GM	57	:group 'pong
	58	:type '(integer))
	59
	60	(defcustom pong-blank-color "black"
67d110f1	61	"Color used for background."
c1475eae	62	:group 'pong
a430ca88	63	:type 'color)
c1475eae GM	64
c1475eae GM	65	(defcustom pong-bat-color "yellow"
67d110f1	66	"Color used for bats."
c1475eae	67	:group 'pong
a430ca88	68	:type 'color)
c1475eae GM	69
c1475eae GM	70	(defcustom pong-ball-color "red"
67d110f1	71	"Color used for the ball."
c1475eae	72	:group 'pong
a430ca88	73	:type 'color)
c1475eae GM	74
c1475eae GM	75	(defcustom pong-border-color "white"
67d110f1	76	"Color used for pong borders."
c1475eae	77	:group 'pong
a430ca88	78	:type 'color)
c1475eae GM	79
c1475eae GM	80	(defcustom pong-left-key "4"
67d110f1	81	"Alternate key to press for bat 1 to go up (primary one is [left])."
c1475eae	82	:group 'pong
a430ca88	83	:type '(restricted-sexp :match-alternatives (stringp vectorp)))
c1475eae GM	84
c1475eae GM	85	(defcustom pong-right-key "6"
67d110f1	86	"Alternate key to press for bat 1 to go down (primary one is [right])."
c1475eae	87	:group 'pong
a430ca88	88	:type '(restricted-sexp :match-alternatives (stringp vectorp)))
c1475eae GM	89
c1475eae GM	90	(defcustom pong-up-key "8"
67d110f1	91	"Alternate key to press for bat 2 to go up (primary one is [up])."
c1475eae	92	:group 'pong
a430ca88	93	:type '(restricted-sexp :match-alternatives (stringp vectorp)))
c1475eae GM	94
c1475eae GM	95	(defcustom pong-down-key "2"
67d110f1	96	"Alternate key to press for bat 2 to go down (primary one is [down])."
c1475eae	97	:group 'pong
a430ca88	98	:type '(restricted-sexp :match-alternatives (stringp vectorp)))
c1475eae GM	99
c1475eae GM	100	(defcustom pong-quit-key "q"
67d110f1	101	"Key to press to quit pong."
c1475eae	102	:group 'pong
a430ca88	103	:type '(restricted-sexp :match-alternatives (stringp vectorp)))
c1475eae GM	104
	105	(defcustom pong-pause-key "p"
	106	"Key to press to pause pong."
	107	:group 'pong
a430ca88	108	:type '(restricted-sexp :match-alternatives (stringp vectorp)))
c1475eae GM	109
c1475eae GM	110	(defcustom pong-resume-key "p"
67d110f1	111	"Key to press to resume pong."
c1475eae	112	:group 'pong
a430ca88	113	:type '(restricted-sexp :match-alternatives (stringp vectorp)))
c1475eae GM	114
c1475eae GM	115	(defcustom pong-timer-delay 0.1
67d110f1	116	"Time to wait between every cycle."
c1475eae	117	:group 'pong
a430ca88	118	:type 'number)
c1475eae GM	119
	120
	121	;;; This is black magic. Define colors used
	122
	123	(defvar pong-blank-options
	124	'(((glyph colorize)
	125	(t ?\040))
	126	((color-x color-x)
	127	(mono-x grid-x)
	128	(color-tty color-tty))
	129	(((glyph color-x) [0 0 0])
	130	(color-tty pong-blank-color))))
	131
	132	(defvar pong-bat-options
	133	'(((glyph colorize)
	134	(emacs-tty ?O)
	135	(t ?\040))
	136	((color-x color-x)
	137	(mono-x mono-x)
	138	(color-tty color-tty)
	139	(mono-tty mono-tty))
	140	(((glyph color-x) [1 1 0])
	141	(color-tty pong-bat-color))))
	142
	143	(defvar pong-ball-options
	144	'(((glyph colorize)
	145	(t ?\*))
	146	((color-x color-x)
	147	(mono-x grid-x)
	148	(color-tty color-tty))
	149	(((glyph color-x) [1 0 0])
	150	(color-tty pong-ball-color))))
	151
	152	(defvar pong-border-options
	153	'(((glyph colorize)
	154	(t ?\+))
	155	((color-x color-x)
6add7517 FP	156	(mono-x grid-x)
	157	(color-tty color-tty))
	158	(((glyph color-x) [0.5 0.5 0.5])
c1475eae GM	159	(color-tty pong-border-color))))
	160
	161	(defconst pong-blank 0)
	162	(defconst pong-bat 1)
	163	(defconst pong-ball 2)
	164	(defconst pong-border 3)
	165
	166
	167	;;; Determine initial positions for bats and ball
	168
	169	(defvar pong-xx nil
	170	"Horizontal speed of the ball.")
	171
	172	(defvar pong-yy nil
	173	"Vertical speed of the ball.")
	174
	175	(defvar pong-x nil
	176	"Horizontal position of the ball.")
	177
	178	(defvar pong-y nil
	179	"Vertical position of the ball.")
	180
	181	(defvar pong-bat-player1 nil
	182	"Vertical position of bat 1.")
	183
	184	(defvar pong-bat-player2 nil
	185	"Vertical position of bat 2.")
	186
	187	(defvar pong-score-player1 nil)
	188	(defvar pong-score-player2 nil)
	189
	190	;;; Initialize maps
	191
	192	(defvar pong-mode-map
	193	(make-sparse-keymap 'pong-mode-map) "Modemap for pong-mode.")
	194
	195	(defvar pong-null-map
	196	(make-sparse-keymap 'pong-null-map) "Null map for pong-mode.")
	197
	198	(define-key pong-mode-map [left] 'pong-move-left)
	199	(define-key pong-mode-map [right] 'pong-move-right)
	200	(define-key pong-mode-map [up] 'pong-move-up)
	201	(define-key pong-mode-map [down] 'pong-move-down)
	202	(define-key pong-mode-map pong-left-key 'pong-move-left)
	203	(define-key pong-mode-map pong-right-key 'pong-move-right)
	204	(define-key pong-mode-map pong-up-key 'pong-move-up)
	205	(define-key pong-mode-map pong-down-key 'pong-move-down)
	206	(define-key pong-mode-map pong-quit-key 'pong-quit)
	207	(define-key pong-mode-map pong-pause-key 'pong-pause)
	208
	209
	210	;;; Fun stuff -- The code
	211
	212	(defun pong-display-options ()
	213	"Computes display options (required by gamegrid for colors)."
	214	(let ((options (make-vector 256 nil)))
	215	(loop for c from 0 to 255 do
	216	(aset options c
	217	(cond ((= c pong-blank)
	218	pong-blank-options)
	219	((= c pong-bat)
	220	pong-bat-options)
	221	((= c pong-ball)
	222	pong-ball-options)
223	((= c pong-border)
224	pong-border-options)
225	(t
226	'(nil nil nil)))))
227	options))
228
229
230
231	(defun pong-init-buffer ()
232	"Initialize pong buffer and draw stuff thanks to gamegrid library."
233	(interactive)
234	(get-buffer-create pong-buffer-name)
235	(switch-to-buffer pong-buffer-name)
236	(use-local-map pong-mode-map)
237
238	(setq gamegrid-use-glyphs t)
239	(setq gamegrid-use-color t)
240	(gamegrid-init (pong-display-options))
241
242	(gamegrid-init-buffer pong-width
243	(+ 2 pong-height)
f47adf18	244	?\s)
c1475eae GM	245
	246	(let ((buffer-read-only nil))
	247	(loop for y from 0 to (1- pong-height) do
	248	(loop for x from 0 to (1- pong-width) do
	249	(gamegrid-set-cell x y pong-border)))
	250	(loop for y from 1 to (- pong-height 2) do
	251	(loop for x from 1 to (- pong-width 2) do
	252	(gamegrid-set-cell x y pong-blank))))
	253
	254	(loop for y from pong-bat-player1 to (1- (+ pong-bat-player1 pong-bat-width)) do
	255	(gamegrid-set-cell 2 y pong-bat))
	256	(loop for y from pong-bat-player2 to (1- (+ pong-bat-player2 pong-bat-width)) do
	257	(gamegrid-set-cell (- pong-width 3) y pong-bat)))
	258
	259
	260
	261	(defun pong-move-left ()
	262	"Move bat 2 up.
	263	This is called left for historical reasons, since in some pong
	264	implementations you move with left/right paddle."
	265	(interactive)
	266	(if (> pong-bat-player1 1)
	267	(and
	268	(setq pong-bat-player1 (1- pong-bat-player1))
	269	(pong-update-bat 2 pong-bat-player1))))
	270
	271
	272
	273	(defun pong-move-right ()
	274	"Move bat 2 up."
	275	(interactive)
	276	(if (< (+ pong-bat-player1 pong-bat-width) (1- pong-height))
	277	(and
	278	(setq pong-bat-player1 (1+ pong-bat-player1))
	279	(pong-update-bat 2 pong-bat-player1))))
	280
	281
	282
	283	(defun pong-move-up ()
	284	"Move bat 2 up."
	285	(interactive)
	286	(if (> pong-bat-player2 1)
	287	(and
	288	(setq pong-bat-player2 (1- pong-bat-player2))
	289	(pong-update-bat (- pong-width 3) pong-bat-player2))))
	290
	291
	292
	293	(defun pong-move-down ()
	294	"Move bat 2 down."
	295	(interactive)
	296	(if (< (+ pong-bat-player2 pong-bat-width) (1- pong-height))
	297	(and
	298	(setq pong-bat-player2 (1+ pong-bat-player2))
	299	(pong-update-bat (- pong-width 3) pong-bat-player2))))
	300
	301
	302
	303	(defun pong-update-bat (x y)
	304	"Move a bat (suppress a cell and draw another one on the other side)."
	305
	306	(cond
	307	((string-equal (buffer-name (current-buffer)) pong-buffer-name)
	308	(gamegrid-set-cell x y pong-bat)
309	(gamegrid-set-cell x (1- (+ y pong-bat-width)) pong-bat)
310	(if (> y 1)
311	(gamegrid-set-cell x (1- y) pong-blank))
312	(if (< (+ y pong-bat-width) (1- pong-height))
313	(gamegrid-set-cell x (+ y pong-bat-width) pong-blank)))))
a1506d29	314
c1475eae GM	315
	316
	317	(defun pong-init ()
	318	"Initialize a game."
a1506d29	319
c1475eae GM	320	(define-key pong-mode-map pong-pause-key 'pong-pause)
c1475eae GM	321
c1475eae GM	322	(add-hook 'kill-buffer-hook 'pong-quit nil t)
	323
	324	;; Initialization of some variables
	325	(setq pong-bat-player1 (1+ (/ (- pong-height pong-bat-width) 2)))
	326	(setq pong-bat-player2 pong-bat-player1)
	327	(setq pong-xx -1)
	328	(setq pong-yy 0)
	329	(setq pong-x (/ pong-width 2))
	330	(setq pong-y (/ pong-height 2))
	331
	332	(pong-init-buffer)
	333	(gamegrid-kill-timer)
	334	(gamegrid-start-timer pong-timer-delay 'pong-update-game)
	335	(pong-update-score))
	336
	337
	338
	339	(defun pong-update-game (pong-buffer)
	340	"\"Main\" function for pong.
	341	It is called every pong-cycle-delay seconds and
	342	updates ball and bats positions. It is responsible of collision
	343	detection and checks if a player scores."
	344	(if (not (eq (current-buffer) pong-buffer))
	345	(pong-pause)
a1506d29	346
c1475eae GM	347	(let ((old-x pong-x)
c1475eae GM	348	(old-y pong-y))
a1506d29	349
c1475eae GM	350	(setq pong-x (+ pong-x pong-xx))
c1475eae GM	351	(setq pong-y (+ pong-y pong-yy))
a1506d29	352
c1475eae GM	353	(if (and (> old-y 0)
	354	(< old-y (- pong-height 1)))
	355	(gamegrid-set-cell old-x old-y pong-blank))
a1506d29	356
c1475eae GM	357	(if (and (> pong-y 0)
	358	(< pong-y (- pong-height 1)))
	359	(gamegrid-set-cell pong-x pong-y pong-ball))
a1506d29	360
c1475eae GM	361	(cond
c1475eae GM	362	((or (= pong-x 3) (= pong-x 2))
a1506d29	363	(if (and (>= pong-y pong-bat-player1)
c1475eae	364	(< pong-y (+ pong-bat-player1 pong-bat-width)))
a1506d29	365	(and
c1475eae	366	(setq pong-yy (+ pong-yy
a1506d29	367	(cond
c1475eae GM	368	((= pong-y pong-bat-player1) -1)
	369	((= pong-y (1+ pong-bat-player1)) 0)
	370	(t 1))))
	371	(setq pong-xx (- pong-xx)))))
	372
	373	((or (= pong-x (- pong-width 4)) (= pong-x (- pong-width 3)))
a1506d29	374	(if (and (>= pong-y pong-bat-player2)
c1475eae	375	(< pong-y (+ pong-bat-player2 pong-bat-width)))
a1506d29	376	(and
c1475eae	377	(setq pong-yy (+ pong-yy
a1506d29	378	(cond
c1475eae GM	379	((= pong-y pong-bat-player2) -1)
	380	((= pong-y (1+ pong-bat-player2)) 0)
	381	(t 1))))
	382	(setq pong-xx (- pong-xx)))))
a1506d29	383
c1475eae GM	384	((<= pong-y 1)
	385	(setq pong-yy (- pong-yy)))
	386
	387	((>= pong-y (- pong-height 2))
	388	(setq pong-yy (- pong-yy)))
	389
	390	((< pong-x 1)
	391	(setq pong-score-player2 (1+ pong-score-player2))
	392	(pong-init))
	393
	394	((>= pong-x (- pong-width 1))
	395	(setq pong-score-player1 (1+ pong-score-player1))
	396	(pong-init))))))
	397
	398
	399
	400	(defun pong-update-score ()
	401	"Update score and print it on bottom of the game grid."
	402	(let* ((string (format "Score: %d / %d" pong-score-player1 pong-score-player2))
	403	(len (length string)))
	404	(loop for x from 0 to (1- len) do
	405	(if (string-equal (buffer-name (current-buffer)) pong-buffer-name)
	406	(gamegrid-set-cell x
	407	pong-height
	408	(aref string x))))))
	409
	410
	411
	412	(defun pong-pause ()
	413	"Pause the game."
	414	(interactive)
	415	(gamegrid-kill-timer)
	416	;; Oooohhh ugly. I don't know why, gamegrid-kill-timer don't do the
	417	;; jobs it is made for. So I have to do it "by hand". Anyway, next
	418	;; line is harmless.
	419	(cancel-function-timers 'pong-update-game)
	420	(define-key pong-mode-map pong-resume-key 'pong-resume))
	421
	422
	423
	424	(defun pong-resume ()
	425	"Resume a paused game."
	426	(interactive)
	427	(define-key pong-mode-map pong-pause-key 'pong-pause)
	428	(gamegrid-start-timer pong-timer-delay 'pong-update-game))
	429
	430
	431
	432	(defun pong-quit ()
	433	"Quit the game and kill the pong buffer."
	434	(interactive)
	435	(gamegrid-kill-timer)
	436	;; Be sure not to draw things in another buffer and wait for some
	437	;; time.
	438	(run-with-timer pong-timer-delay nil 'kill-buffer pong-buffer-name))
	439
	440
	441
	442	;;;###autoload
	443	(defun pong ()
	444	"Play pong and waste time.
	445	This is an implementation of the classical game pong.
	446	Move left and right bats and try to bounce the ball to your opponent.
	447
e8951be0	448	pong-mode keybindings:\\<pong-mode-map>
c1475eae	449
e8951be0	450	\\{pong-mode-map}"
c1475eae GM	451	(interactive)
	452	(setq pong-score-player1 0)
	453	(setq pong-score-player2 0)
	454	(pong-init))
	455
	456
	457
	458	(provide 'pong)
6e44da43 PJ	459
6e44da43 PJ	460	;;; pong.el ends here