annotate lisp/play/pong.el @ 40483:b7f7d0cc89fb

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