From 724edda223ad1a0a95a94bf4ec89c95e91654a14 Mon Sep 17 00:00:00 2001 From: Gwenhael Le Moine Date: Wed, 6 Jul 2011 11:20:38 +0200 Subject: [PATCH] add pong.el (from http://groups.google.com/group/gnu.emacs.sources/msg/e2fd6669e4fa9a05 ) and adapt SlackBuild to install it (and future saved .el put there too) Signed-off-by: Gwenhael Le Moine --- e/divers-el/divers-el.SlackBuild | 2 +- e/divers-el/pong.el | 289 +++++++++++++++++++++++++++++++ 2 files changed, 290 insertions(+), 1 deletion(-) create mode 100644 e/divers-el/pong.el diff --git a/e/divers-el/divers-el.SlackBuild b/e/divers-el/divers-el.SlackBuild index 76baf28b..82bb184f 100755 --- a/e/divers-el/divers-el.SlackBuild +++ b/e/divers-el/divers-el.SlackBuild @@ -68,7 +68,7 @@ done mkdir -p $PKG$PREFIX/share/emacs/$EMACS_VERSION/etc/themes $PKG$PREFIX/share/emacs/site-lisp/ cd $PKG$PREFIX/share/emacs/site-lisp/ -cp $CWD/els/*.el . +cp $CWD/els/*.el $CWD/*.el . $EMACS -batch -f batch-byte-compile *.el cd $PKG$PREFIX/share/emacs/$EMACS_VERSION/etc/themes cp $CWD/themes/*.el . diff --git a/e/divers-el/pong.el b/e/divers-el/pong.el new file mode 100644 index 00000000..67582944 --- /dev/null +++ b/e/divers-el/pong.el @@ -0,0 +1,289 @@ +;;; pong.el v0.1 --- Emacs implementation of pong + +;; Copyright (C) 1999 by Free Software Foundation, Inc. + +;; Author: Benjamin Drieu +;; Keywords: games + +;; This file is NOT part of GNU Emacs. + +;; GNU Emacs and this file are free software; you can redistribute +;; them and/or modify them 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. + +;; GNU Emacs and this file are distributed in the hope that they 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This is an implementation of the classical game pong. + +;;; Code: + +(require 'cl) +(require 'gamegrid) + +(defvar pong-buffer-name "*Pong*") + +(defvar pong-width 50) +(defvar pong-height 30) +(defvar pong-raquette-width 3) +(defvar pong-raoul-raquette (/ (- pong-height pong-raquette-width) 2)) +(defvar pong-albert-raquette 10) +(defvar pong-xx -1) +(defvar pong-yy 1) +(defvar pong-x (/ pong-width 2)) +(defvar pong-y (/ pong-height 2)) + +(defvar pong-mode-map + (make-sparse-keymap 'pong-mode-map)) + +(defvar pong-null-map + (make-sparse-keymap 'pong-null-map)) + +(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 "q" 'pong-quit) +(define-key pong-mode-map "p" 'pong-pause) + +(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 "black")))) + +(defvar pong-brick-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 "yellow")))) + +(defvar pong-dot-options + '(((glyph colorize) + (t ?\*)) + ((color-x color-x) + (mono-x grid-x) + (color-tty color-tty)) + (((glyph color-x) [1 0 0]) + (color-tty "red")))) + +(defvar pong-border-options + '(((glyph colorize) + (t ?\+)) + ((color-x color-x) + (mono-x grid-x)) + (((glyph color-x) [0.5 0.5 0.5]) + (color-tty "white")))) + +(defvar pong-space-options + '(((t ?\040)) + nil + nil)) + +(defconst pong-blank 0) +(defconst pong-brick 1) +(defconst pong-dot 2) +(defconst pong-border 3) +(defconst pong-space 4) + +(defun pong-display-options () + (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-brick) + pong-brick-options) + ((= c pong-dot) + pong-dot-options) + ((= c pong-border) + pong-border-options) + ((= c pong-space) + pong-space-options) + (t + '(nil nil nil))))) + options)) + +(defun pong-init-buffer () + (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) + 1) + + (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-raoul-raquette to (1- (+ pong-raoul-raquette pong-raquette-width)) do + (gamegrid-set-cell 2 y pong-brick)) + (loop for y from pong-albert-raquette to (1- (+ pong-albert-raquette pong-raquette-width)) do + (gamegrid-set-cell (- pong-width 3) y pong-brick) +)) + +(defun pong-move-left () + "" + (interactive) + (if (> pong-raoul-raquette 1) + (and + (setq pong-raoul-raquette (1- pong-raoul-raquette)) + (pong-update-raquette pong-raoul-raquette 2 pong-raoul-raquette)))) + +(defun pong-move-right () + "" + (interactive) + (if (< (+ pong-raoul-raquette pong-raquette-width) (1- pong-height)) + (and + (setq pong-raoul-raquette (1+ pong-raoul-raquette)) + (pong-update-raquette pong-raoul-raquette 2 pong-raoul-raquette)))) + +(defun pong-move-up () + "" + (interactive) + (if (> pong-albert-raquette 1) + (and + (setq pong-albert-raquette (1- pong-albert-raquette)) + (pong-update-raquette pong-albert-raquette (- pong-width 3) pong-albert-raquette)))) + +(defun pong-move-down () + "" + (interactive) + (if (< (+ pong-albert-raquette pong-raquette-width) (1- pong-height)) + (and + (setq pong-albert-raquette (1+ pong-albert-raquette)) + (pong-update-raquette pong-albert-raquette (- pong-width 3) pong-albert-raquette)))) + +(defun pong-update-raquette (pong-raquette x y) + (gamegrid-set-cell x y pong-brick) + (gamegrid-set-cell x (1- (+ y pong-raquette-width)) pong-brick) + (if (> y 1) + (gamegrid-set-cell x (1- y) pong-blank)) + (if (< (+ pong-raquette pong-raquette-width) (1- pong-height)) + (gamegrid-set-cell x (+ y pong-raquette-width) pong-blank))) + +(defun pong () + "" + (interactive) + (setq pong-raoul-score 0) + (setq pong-albert-score 0) + (pong-init-game)) + +(defun pong-init-game () + (cancel-function-timers 'pong-update-game) + (setq pong-raquette-width 3) + (setq pong-raoul-raquette (/ (- pong-height pong-raquette-width) 2)) + (setq pong-albert-raquette pong-raoul-raquette) + (setq pong-xx -1) + (setq pong-yy 0) + (setq pong-x (/ pong-width 2)) + (setq pong-y (/ pong-height 2)) + (pong-init-buffer) + (gamegrid-start-timer 0.1 'pong-update-game) + (pong-update-score)) + +(defun pong-update-game (pong-buffer) + "" + (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-dot)) + + (cond + ((or (= pong-x 3) (= pong-x 2)) + (if (and (>= pong-y pong-raoul-raquette) + (< pong-y (+ pong-raoul-raquette pong-raquette-width))) + (and + (setq pong-yy (+ pong-yy + (cond + ((= pong-y pong-raoul-raquette) -1) + ((= pong-y (1+ pong-raoul-raquette)) 0) + (t 1)))) + (setq pong-xx (- pong-xx))))) + + ((or (= pong-x (- pong-width 4)) (= pong-x (- pong-width 3))) + (if (and (>= pong-y pong-albert-raquette) + (< pong-y (+ pong-albert-raquette pong-raquette-width))) + (and + (setq pong-yy (+ pong-yy + (cond + ((= pong-y pong-albert-raquette) -1) + ((= pong-y (1+ pong-albert-raquette)) 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-albert-score (1+ pong-albert-score)) + (pong-init-game)) + + ((>= pong-x (- pong-width 1)) + (setq pong-raoul-score (1+ pong-raoul-score)) + (pong-init-game))))) + +(defun pong-update-score () + (let* ((string (format "Score: %d / %d" pong-raoul-score pong-albert-score)) + (len (length string))) + (loop for x from 0 to (1- len) do + (gamegrid-set-cell x + pong-height + (aref string x))))) + +(defun pong-pause () + (interactive) + (define-key pong-mode-map "p" 'pong-resume) + (cancel-function-timers (quote pong-update-game))) + +(defun pong-resume () + (interactive) + (define-key pong-mode-map "p" 'pong-pause) + (gamegrid-start-timer 0.1 'pong-update-game)) + +(defun pong-quit () + (interactive) + (cancel-function-timers (quote pong-update-game)) + (kill-buffer pong-buffer-name)) + +;;; pong.el ends here