;;; pong.el --- classical implementation of pong
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Benjamin Drieu <bdrieu@april.org>
;; Keywords: games
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'gamegrid)
:group 'games)
(defcustom pong-buffer-name "*Pong*"
- "*Name of the buffer used to play."
+ "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)
;;; Initialize maps
(defvar pong-mode-map
- (make-sparse-keymap 'pong-mode-map) "Modemap for pong-mode.")
+ (let ((map (make-sparse-keymap 'pong-mode-map)))
+ (define-key map [left] 'pong-move-left)
+ (define-key map [right] 'pong-move-right)
+ (define-key map [up] 'pong-move-up)
+ (define-key map [down] 'pong-move-down)
+ (define-key map pong-left-key 'pong-move-left)
+ (define-key map pong-right-key 'pong-move-right)
+ (define-key map pong-up-key 'pong-move-up)
+ (define-key map pong-down-key 'pong-move-down)
+ (define-key map pong-quit-key 'pong-quit)
+ (define-key map pong-pause-key 'pong-pause)
+ 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
+ (dotimes (c 256)
(aset options c
- (cond ((= c pong-blank)
- pong-blank-options)
+ (cond ((= c pong-blank)
+ pong-blank-options)
((= c pong-bat)
- pong-bat-options)
+ pong-bat-options)
((= c pong-ball)
- pong-ball-options)
+ pong-ball-options)
((= c pong-border)
- pong-border-options)
+ pong-border-options)
(t
- '(nil nil nil)))))
+ '(nil nil nil)))))
options))
?\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)))
+ (dotimes (y pong-height)
+ (dotimes (x pong-width)
+ (gamegrid-set-cell x y pong-border)))
+ (cl-loop for y from 1 to (- pong-height 2) do
+ (cl-loop for x from 1 to (- pong-width 2) do
+ (gamegrid-set-cell x y pong-blank))))
+ (cl-loop for y from pong-bat-player1
+ to (1- (+ pong-bat-player1 pong-bat-width))
+ do (gamegrid-set-cell 2 y pong-bat))
+ (cl-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 ()
(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))
+ (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))))))
+ (dotimes (x len)
+ (if (string-equal (buffer-name (current-buffer)) pong-buffer-name)
+ (gamegrid-set-cell x pong-height (aref string x))))))
(provide 'pong)
-;; arch-tag: 1fdf0fc5-13e2-4de4-aae4-09bdd5af99f3
;;; pong.el ends here