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