annotate lisp/play/gamegrid.el @ 43128:d7ccb71bc97c

(french-prefix): ", " => "," and "~ " => "~". Don't define "~," at all.
author Richard M. Stallman <rms@gnu.org>
date Wed, 06 Feb 2002 15:23:30 +0000
parents 7541bec297e3
children 3075554223d1
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
38425
c6e12c6b1498 Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 22490
diff changeset
1 ;;; gamegrid.el --- library for implementing grid-based games on Emacs
22490
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3 ;; Copyright (C) 1997, 1998 Free Software Foundation, Inc.
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Author: Glynn Clements <glynn@sensei.co.uk>
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6 ;; Version: 1.02
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; Created: 1997-08-13
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8 ;; Keywords: games
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10 ;; This file is part of GNU Emacs.
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 ;; it under the terms of the GNU General Public License as published by
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15 ;; any later version.
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; GNU Emacs is distributed in the hope that it will be useful,
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20 ;; GNU General Public License for more details.
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 ;; Boston, MA 02111-1307, USA.
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27 ;;; Commentary:
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28
38425
c6e12c6b1498 Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 22490
diff changeset
29 ;;; Code:
c6e12c6b1498 Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 22490
diff changeset
30
22490
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 (eval-when-compile
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32 (require 'cl))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34 ;; ;;;;;;;;;;;;; buffer-local variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36 (defvar gamegrid-use-glyphs t
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 "Non-nil means use glyphs when available.")
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 (defvar gamegrid-use-color t
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 "Non-nil means use color when available.")
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 (defvar gamegrid-font "-*-courier-medium-r-*-*-*-140-100-75-*-*-iso8859-*"
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 "Name of the font used in X mode.")
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 (defvar gamegrid-display-options nil)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 (defvar gamegrid-buffer-width 0)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 (defvar gamegrid-buffer-height 0)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49 (defvar gamegrid-blank 0)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 (defvar gamegrid-timer nil)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 (defvar gamegrid-display-mode nil)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 (defvar gamegrid-display-table)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 (defvar gamegrid-face-table nil)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 (defvar gamegrid-buffer-start 1)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 (defvar gamegrid-score-file-length 50
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 "Number of high scores to keep")
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 (make-variable-buffer-local 'gamegrid-use-glyphs)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 (make-variable-buffer-local 'gamegrid-use-color)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 (make-variable-buffer-local 'gamegrid-font)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 (make-variable-buffer-local 'gamegrid-display-options)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 (make-variable-buffer-local 'gamegrid-buffer-width)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 (make-variable-buffer-local 'gamegrid-buffer-height)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 (make-variable-buffer-local 'gamegrid-blank)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 (make-variable-buffer-local 'gamegrid-timer)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 (make-variable-buffer-local 'gamegrid-display-mode)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 (make-variable-buffer-local 'gamegrid-display-table)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 (make-variable-buffer-local 'gamegrid-face-table)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 (make-variable-buffer-local 'gamegrid-buffer-start)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 (make-variable-buffer-local 'gamegrid-score-file-length)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 ;; ;;;;;;;;;;;;; global variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 (defvar gamegrid-grid-x-face nil)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 (defvar gamegrid-mono-x-face nil)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 (defvar gamegrid-mono-tty-face nil)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86 (defconst gamegrid-glyph-height 16)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 (defconst gamegrid-xpm "\
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 /* XPM */
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 static char *noname[] = {
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 /* width height ncolors chars_per_pixel */
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92 \"16 16 3 1\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 /* colors */
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94 \"+ s col1\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 \". s col2\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 \"- s col3\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 /* pixels */
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 \"---------------+\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 \"--------------++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 \"--............++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101 \"--............++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 \"--............++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 \"--............++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 \"--............++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 \"--............++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 \"--............++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 \"--............++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108 \"--............++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 \"--............++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110 \"--............++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 \"--............++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112 \"-+++++++++++++++\",
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113 \"++++++++++++++++\"
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 };
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115 "
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116 "XPM format image used for each square")
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
117
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 ;; ;;;;;;;;;;;;;;;; miscellaneous functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 (defsubst gamegrid-characterp (arg)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121 (if (fboundp 'characterp)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122 (characterp arg)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
123 (integerp arg)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 (defsubst gamegrid-event-x (event)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126 (if (fboundp 'event-x)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127 (event-x event)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128 (car (posn-col-row (event-end event)))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 (defsubst gamegrid-event-y (event)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 (if (fboundp 'event-y)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
132 (event-y event)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 (cdr (posn-col-row (event-end event)))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135 ;; ;;;;;;;;;;;;; display functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137 (defun gamegrid-color (color shade)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138 (let* ((v (floor (* shade 255)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139 (r (* v (aref color 0)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140 (g (* v (aref color 1)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 (b (* v (aref color 2))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142 (format "#%02x%02x%02x" r g b)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 (defun gamegrid-set-font (face)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145 (if gamegrid-font
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146 (condition-case nil
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 (set-face-font face gamegrid-font)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 ('error nil))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
149
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 (defun gamegrid-setup-face (face color)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 (set-face-foreground face color)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152 (set-face-background face color)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
153 (gamegrid-set-font face)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
154 (condition-case nil
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
155 (set-face-background-pixmap face [nothing]);; XEmacs
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 ('error nil))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157 (condition-case nil
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158 (set-face-background-pixmap face nil);; Emacs
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
159 ('error nil)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
161 (defun gamegrid-make-mono-tty-face ()
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
162 (let ((face (make-face 'gamegrid-mono-tty-face)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
163 (condition-case nil
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
164 (set-face-property face 'reverse t)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 ('error nil))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166 face))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
167
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168 (defun gamegrid-make-color-tty-face (color)
43117
7541bec297e3 (gamegrid-display-type): Treat any
Eli Zaretskii <eliz@gnu.org>
parents: 41560
diff changeset
169 (let* ((color-str (symbol-value color))
7541bec297e3 (gamegrid-display-type): Treat any
Eli Zaretskii <eliz@gnu.org>
parents: 41560
diff changeset
170 (name (intern (format "gamegrid-color-tty-face-%s" color-str)))
22490
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171 (face (make-face name)))
43117
7541bec297e3 (gamegrid-display-type): Treat any
Eli Zaretskii <eliz@gnu.org>
parents: 41560
diff changeset
172 (gamegrid-setup-face face color-str)
22490
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 face))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175 (defun gamegrid-make-grid-x-face ()
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 (let ((face (make-face 'gamegrid-x-border-face)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177 (gamegrid-set-font face)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178 face))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
179
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180 (defun gamegrid-make-mono-x-face ()
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 (let ((face (make-face 'gamegrid-mono-x-face))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 (color (face-foreground 'default)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183 (if (null color)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
184 (setq color
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 (cdr-safe (assq 'foreground-color (frame-parameters)))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186 (gamegrid-setup-face face color)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187 face))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189 (defun gamegrid-make-color-x-face (color)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 (let* ((hex (gamegrid-color color 1.0))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191 (name (intern (format "gamegrid-color-x-face-%s" hex)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192 (face (make-face name)))
43117
7541bec297e3 (gamegrid-display-type): Treat any
Eli Zaretskii <eliz@gnu.org>
parents: 41560
diff changeset
193 (gamegrid-setup-face face hex)
22490
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194 face))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196 (defun gamegrid-make-face (data-spec-list color-spec-list)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197 (let ((data (gamegrid-match-spec-list data-spec-list))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 (color (gamegrid-match-spec-list color-spec-list)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
199 (case data
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200 ('color-x
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201 (gamegrid-make-color-x-face color))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202 ('grid-x
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
203 (unless gamegrid-grid-x-face
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204 (setq gamegrid-grid-x-face (gamegrid-make-grid-x-face)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
205 gamegrid-grid-x-face)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206 ('mono-x
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207 (unless gamegrid-mono-x-face
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208 (setq gamegrid-mono-x-face (gamegrid-make-mono-x-face)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 gamegrid-mono-x-face)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210 ('color-tty
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211 (gamegrid-make-color-tty-face color))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
212 ('mono-tty
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
213 (unless gamegrid-mono-tty-face
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
214 (setq gamegrid-mono-tty-face (gamegrid-make-mono-tty-face)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
215 gamegrid-mono-tty-face))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
216
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
217 (defun gamegrid-colorize-glyph (color)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
218 (make-glyph
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
219 (vector
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
220 'xpm
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
221 :data gamegrid-xpm
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
222 :color-symbols (list (cons "col1" (gamegrid-color color 0.6))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
223 (cons "col2" (gamegrid-color color 0.8))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
224 (cons "col3" (gamegrid-color color 1.0))))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
225
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 (defun gamegrid-match-spec (spec)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227 (let ((locale (car spec))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
228 (value (cadr spec)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229 (and (or (eq locale t)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230 (and (listp locale)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231 (memq gamegrid-display-mode locale))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232 (and (symbolp locale)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
233 (eq gamegrid-display-mode locale)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234 value)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 (defun gamegrid-match-spec-list (spec-list)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 (and spec-list
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238 (or (gamegrid-match-spec (car spec-list))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
239 (gamegrid-match-spec-list (cdr spec-list)))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241 (defun gamegrid-make-glyph (data-spec-list color-spec-list)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242 (let ((data (gamegrid-match-spec-list data-spec-list))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
243 (color (gamegrid-match-spec-list color-spec-list)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
244 (cond ((gamegrid-characterp data)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
245 (vector data))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246 ((eq data 'colorize)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247 (gamegrid-colorize-glyph color))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
248 ((vectorp data)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249 (make-glyph data)))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
251 (defun gamegrid-color-display-p ()
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
252 (if (fboundp 'device-class)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 (eq (device-class (selected-device)) 'color)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
254 (eq (cdr-safe (assq 'display-type (frame-parameters))) 'color)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
256 (defun gamegrid-display-type ()
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
257 (let ((window-system-p
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
258 (or (and (fboundp 'console-on-window-system-p)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
259 (console-on-window-system-p))
43117
7541bec297e3 (gamegrid-display-type): Treat any
Eli Zaretskii <eliz@gnu.org>
parents: 41560
diff changeset
260 (and (fboundp 'display-color-p)
7541bec297e3 (gamegrid-display-type): Treat any
Eli Zaretskii <eliz@gnu.org>
parents: 41560
diff changeset
261 (display-color-p))
22490
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
262 window-system)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
263 (cond ((and gamegrid-use-glyphs
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
264 window-system-p
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
265 (featurep 'xpm))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
266 'glyph)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
267 ((and gamegrid-use-color
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
268 window-system-p
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
269 (gamegrid-color-display-p))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
270 'color-x)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
271 (window-system-p
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
272 'mono-x)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
273 ((and gamegrid-use-color
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
274 (gamegrid-color-display-p))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
275 'color-tty)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
276 ((fboundp 'set-face-property)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
277 'mono-tty)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
278 (t
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
279 'emacs-tty))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
280
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
281 (defun gamegrid-set-display-table ()
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
282 (if (fboundp 'specifierp)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
283 (add-spec-to-specifier current-display-table
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
284 gamegrid-display-table
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
285 (current-buffer)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
286 nil
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
287 'remove-locale)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
288 (setq buffer-display-table gamegrid-display-table)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
289
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
290 (defun gamegrid-hide-cursor ()
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
291 (if (fboundp 'specifierp)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
292 (set-specifier text-cursor-visible-p nil (current-buffer))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
293
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
294 (defun gamegrid-setup-default-font ()
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
295 (cond ((eq gamegrid-display-mode 'glyph)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
296 (let* ((font-spec (face-property 'default 'font))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
297 (name (font-name font-spec))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
298 (max-height nil))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
299 (loop for c from 0 to 255 do
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
300 (let ((glyph (aref gamegrid-display-table c)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
301 (cond ((glyphp glyph)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
302 (let ((height (glyph-height glyph)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
303 (if (or (null max-height)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
304 (< max-height height))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
305 (setq max-height height)))))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
306 (if max-height
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
307 (while (and (> (font-height font-spec) max-height)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308 (setq name (x-find-smaller-font name)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309 (add-spec-to-specifier font-spec name (current-buffer))))))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
310
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
311 (defun gamegrid-initialize-display ()
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
312 (setq gamegrid-display-mode (gamegrid-display-type))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
313 (setq gamegrid-display-table (make-display-table))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
314 (setq gamegrid-face-table (make-vector 256 nil))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
315 (loop for c from 0 to 255 do
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
316 (let* ((spec (aref gamegrid-display-options c))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
317 (glyph (gamegrid-make-glyph (car spec) (caddr spec)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
318 (face (gamegrid-make-face (cadr spec) (caddr spec))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
319 (aset gamegrid-face-table c face)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
320 (aset gamegrid-display-table c glyph)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
321 (gamegrid-setup-default-font)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
322 (gamegrid-set-display-table)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
323 (gamegrid-hide-cursor))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
324
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
325
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
326 (defun gamegrid-set-face (c)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
327 (unless (eq gamegrid-display-mode 'glyph)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
328 (put-text-property (1- (point))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
329 (point)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
330 'face
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
331 (aref gamegrid-face-table c))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
332
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
333 (defun gamegrid-cell-offset (x y)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
334 (+ gamegrid-buffer-start
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
335 (* (1+ gamegrid-buffer-width) y)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
336 x))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
337
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
338 ;; ;;;;;;;;;;;;;;;; grid functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
339
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
340 (defun gamegrid-get-cell (x y)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
341 (char-after (gamegrid-cell-offset x y)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
342
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
343 (defun gamegrid-set-cell (x y c)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
344 (save-excursion
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
345 (let ((buffer-read-only nil))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
346 (goto-char (gamegrid-cell-offset x y))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
347 (delete-char 1)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
348 (insert-char c 1)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
349 (gamegrid-set-face c))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
350
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
351 (defun gamegrid-init-buffer (width height blank)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
352 (setq gamegrid-buffer-width width
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
353 gamegrid-buffer-height height)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
354 (let ((line (concat
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
355 (make-string width blank)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
356 "\n"))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
357 (buffer-read-only nil))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
358 (erase-buffer)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
359 (setq gamegrid-buffer-start (point))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
360 (dotimes (i height)
41560
7428670426b2 (gamegrid-init-buffer): Use insert instead of insert-string.
Pavel Janík <Pavel@Janik.cz>
parents: 38425
diff changeset
361 (insert line))
22490
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
362 (goto-char (point-min))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
363
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
364 (defun gamegrid-init (options)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
365 (setq buffer-read-only t
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
366 truncate-lines t
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
367 gamegrid-display-options options)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
368 (buffer-disable-undo (current-buffer))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
369 (gamegrid-initialize-display))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
370
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
371 ;; ;;;;;;;;;;;;;;;; timer functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
372
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
373 (defun gamegrid-start-timer (period func)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
374 (setq gamegrid-timer
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
375 (if (featurep 'itimer)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
376 (start-itimer "Gamegrid"
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
377 func
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
378 period
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
379 period
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
380 nil
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
381 t
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
382 (current-buffer))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
383 (run-with-timer period
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
384 period
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
385 func
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
386 (current-buffer)))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
387
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
388 (defun gamegrid-set-timer (delay)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
389 (if gamegrid-timer
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
390 (if (featurep 'itimer)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
391 (set-itimer-restart gamegrid-timer delay)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
392 (timer-set-time gamegrid-timer
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
393 (list (aref gamegrid-timer 1)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
394 (aref gamegrid-timer 2)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
395 (aref gamegrid-timer 3))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
396 delay))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
397
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
398 (defun gamegrid-kill-timer ()
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
399 (if gamegrid-timer
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
400 (if (featurep 'itimer)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
401 (delete-itimer gamegrid-timer)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
402 (timer-set-time gamegrid-timer '(0 0 0) nil)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
403 (setq gamegrid-timer nil))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
404
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
405 ;; ;;;;;;;;;;;;;;; high score functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
406
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
407 (defun gamegrid-add-score (file score)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
408 "Add the current score to the high score file."
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
409 (save-excursion
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
410 (find-file-other-window file)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
411 (setq buffer-read-only nil)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
412 (goto-char (point-max))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
413 (insert (format "%05d\t%s\t%s <%s>\n"
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
414 score
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
415 (current-time-string)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
416 (user-full-name)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
417 (cond ((fboundp 'user-mail-address)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
418 (user-mail-address))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
419 ((boundp 'user-mail-address)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
420 user-mail-address)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
421 (t ""))))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
422 (sort-numeric-fields 1 (point-min) (point-max))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
423 (reverse-region (point-min) (point-max))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
424 (goto-line (1+ gamegrid-score-file-length))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
425 (delete-region (point) (point-max))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
426 (setq buffer-read-only t)
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
427 (save-buffer)))
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
428
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
429 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
430
75a50246a099 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
431 (provide 'gamegrid)
38425
c6e12c6b1498 Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 22490
diff changeset
432
c6e12c6b1498 Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 22490
diff changeset
433 ;;; gamegrid.el ends here