1;;; gamegrid.el --- library for implementing grid-based games on Emacs 2 3;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Glynn Clements <glynn@sensei.co.uk> 7;; Version: 1.02 8;; Created: 1997-08-13 9;; Keywords: games 10 11;; This file is part of GNU Emacs. 12 13;; GNU Emacs is free software; you can redistribute it and/or modify 14;; it under the terms of the GNU General Public License as published by 15;; the Free Software Foundation; either version 2, or (at your option) 16;; any later version. 17 18;; GNU Emacs is distributed in the hope that it will be useful, 19;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21;; GNU General Public License for more details. 22 23;; You should have received a copy of the GNU General Public License 24;; along with GNU Emacs; see the file COPYING. If not, write to the 25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26;; Boston, MA 02110-1301, USA. 27 28;;; Commentary: 29 30;;; Code: 31 32(eval-when-compile 33 (require 'cl)) 34 35;; ;;;;;;;;;;;;; buffer-local variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36 37(defvar gamegrid-use-glyphs t 38 "Non-nil means use glyphs when available.") 39 40(defvar gamegrid-use-color t 41 "Non-nil means use color when available.") 42 43(defvar gamegrid-font "-*-courier-medium-r-*-*-*-140-100-75-*-*-iso8859-*" 44 "Name of the font used in X mode.") 45 46(defvar gamegrid-face nil 47 "Indicates the face to use as a default.") 48(make-variable-buffer-local 'gamegrid-face) 49 50(defvar gamegrid-display-options nil) 51 52(defvar gamegrid-buffer-width 0) 53(defvar gamegrid-buffer-height 0) 54(defvar gamegrid-blank 0) 55 56(defvar gamegrid-timer nil) 57 58(defvar gamegrid-display-mode nil) 59 60(defvar gamegrid-display-table) 61 62(defvar gamegrid-face-table nil) 63 64(defvar gamegrid-buffer-start 1) 65 66(defvar gamegrid-score-file-length 50 67 "Number of high scores to keep") 68 69(defvar gamegrid-user-score-file-directory "~/.emacs.d/games" 70 "A directory for game scores which can't be shared. 71If Emacs was built without support for shared game scores, then this 72directory will be used.") 73 74(make-variable-buffer-local 'gamegrid-use-glyphs) 75(make-variable-buffer-local 'gamegrid-use-color) 76(make-variable-buffer-local 'gamegrid-font) 77(make-variable-buffer-local 'gamegrid-display-options) 78(make-variable-buffer-local 'gamegrid-buffer-width) 79(make-variable-buffer-local 'gamegrid-buffer-height) 80(make-variable-buffer-local 'gamegrid-blank) 81(make-variable-buffer-local 'gamegrid-timer) 82(make-variable-buffer-local 'gamegrid-display-mode) 83(make-variable-buffer-local 'gamegrid-display-table) 84(make-variable-buffer-local 'gamegrid-face-table) 85(make-variable-buffer-local 'gamegrid-buffer-start) 86(make-variable-buffer-local 'gamegrid-score-file-length) 87 88;; ;;;;;;;;;;;;; global variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 89 90(defvar gamegrid-grid-x-face nil) 91(defvar gamegrid-mono-x-face nil) 92(defvar gamegrid-mono-tty-face nil) 93 94;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 95 96(defconst gamegrid-glyph-height 16) 97 98(defconst gamegrid-xpm "\ 99/* XPM */ 100static char *noname[] = { 101/* width height ncolors chars_per_pixel */ 102\"16 16 3 1\", 103/* colors */ 104\"+ s col1\", 105\". s col2\", 106\"- s col3\", 107/* pixels */ 108\"---------------+\", 109\"--------------++\", 110\"--............++\", 111\"--............++\", 112\"--............++\", 113\"--............++\", 114\"--............++\", 115\"--............++\", 116\"--............++\", 117\"--............++\", 118\"--............++\", 119\"--............++\", 120\"--............++\", 121\"--............++\", 122\"-+++++++++++++++\", 123\"++++++++++++++++\" 124}; 125" 126 "XPM format image used for each square") 127 128(defvar gamegrid-xbm "\ 129/* gamegrid XBM */ 130#define gamegrid_width 16 131#define gamegrid_height 16 132static unsigned char gamegrid_bits[] = { 133 0xff, 0xff, 0xff, 0x7f, 0xff, 0x3f, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, 134 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, 135 0x57, 0x15, 0x07, 0x00, 0x03, 0x00, 0x01, 0x00 };" 136 "XBM format image used for each square.") 137 138;; ;;;;;;;;;;;;;;;; miscellaneous functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 139 140(defsubst gamegrid-characterp (arg) 141 (if (fboundp 'characterp) 142 (characterp arg) 143 (integerp arg))) 144 145(defsubst gamegrid-event-x (event) 146 (if (fboundp 'event-x) 147 (event-x event) 148 (car (posn-col-row (event-end event))))) 149 150(defsubst gamegrid-event-y (event) 151 (if (fboundp 'event-y) 152 (event-y event) 153 (cdr (posn-col-row (event-end event))))) 154 155;; ;;;;;;;;;;;;; display functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 156 157(defun gamegrid-color (color shade) 158 (let* ((v (floor (* shade 255))) 159 (r (* v (aref color 0))) 160 (g (* v (aref color 1))) 161 (b (* v (aref color 2)))) 162 (format "#%02x%02x%02x" r g b))) 163 164(defun gamegrid-set-font (face) 165 (if gamegrid-font 166 (condition-case nil 167 (set-face-font face gamegrid-font) 168 (error nil)))) 169 170(defun gamegrid-setup-face (face color) 171 (set-face-foreground face color) 172 (set-face-background face color) 173 (gamegrid-set-font face) 174 (condition-case nil 175 (set-face-background-pixmap face [nothing]);; XEmacs 176 (error nil)) 177 (condition-case nil 178 (set-face-background-pixmap face nil);; Emacs 179 (error nil))) 180 181(defun gamegrid-make-mono-tty-face () 182 (let ((face (make-face 'gamegrid-mono-tty-face))) 183 (set-face-inverse-video-p face t) 184 face)) 185 186(defun gamegrid-make-color-tty-face (color) 187 (let* ((color-str (if (symbolp color) (symbol-value color) color)) 188 (name (intern (format "gamegrid-color-tty-face-%s" color-str))) 189 (face (make-face name))) 190 (gamegrid-setup-face face color-str) 191 face)) 192 193(defun gamegrid-make-grid-x-face () 194 (let ((face (make-face 'gamegrid-x-border-face))) 195 (gamegrid-set-font face) 196 face)) 197 198(defun gamegrid-make-mono-x-face () 199 (let ((face (make-face 'gamegrid-mono-x-face)) 200 (color (face-foreground 'default))) 201 (if (null color) 202 (setq color 203 (cdr-safe (assq 'foreground-color (frame-parameters))))) 204 (gamegrid-setup-face face color) 205 face)) 206 207(defun gamegrid-make-color-x-face (color) 208 (let* ((hex (gamegrid-color color 1.0)) 209 (name (intern (format "gamegrid-color-x-face-%s" hex))) 210 (face (make-face name))) 211 (gamegrid-setup-face face hex) 212 face)) 213 214(defun gamegrid-make-face (data-spec-list color-spec-list) 215 (let ((data (gamegrid-match-spec-list data-spec-list)) 216 (color (gamegrid-match-spec-list color-spec-list))) 217 (case data 218 ('color-x 219 (gamegrid-make-color-x-face color)) 220 ('grid-x 221 (unless gamegrid-grid-x-face 222 (setq gamegrid-grid-x-face (gamegrid-make-grid-x-face))) 223 gamegrid-grid-x-face) 224 ('mono-x 225 (unless gamegrid-mono-x-face 226 (setq gamegrid-mono-x-face (gamegrid-make-mono-x-face))) 227 gamegrid-mono-x-face) 228 ('color-tty 229 (gamegrid-make-color-tty-face color)) 230 ('mono-tty 231 (unless gamegrid-mono-tty-face 232 (setq gamegrid-mono-tty-face (gamegrid-make-mono-tty-face))) 233 gamegrid-mono-tty-face)))) 234 235(defun gamegrid-colorize-glyph (color) 236 (find-image `((:type xpm :data ,gamegrid-xpm 237 :ascent center 238 :color-symbols 239 (("col1" . ,(gamegrid-color color 0.6)) 240 ("col2" . ,(gamegrid-color color 0.8)) 241 ("col3" . ,(gamegrid-color color 1.0)))) 242 (:type xbm :data ,gamegrid-xbm 243 :ascent center 244 :foreground ,(gamegrid-color color 1.0) 245 :background ,(gamegrid-color color 0.5))))) 246 247(defun gamegrid-match-spec (spec) 248 (let ((locale (car spec)) 249 (value (cadr spec))) 250 (and (or (eq locale t) 251 (and (listp locale) 252 (memq gamegrid-display-mode locale)) 253 (and (symbolp locale) 254 (eq gamegrid-display-mode locale))) 255 value))) 256 257(defun gamegrid-match-spec-list (spec-list) 258 (and spec-list 259 (or (gamegrid-match-spec (car spec-list)) 260 (gamegrid-match-spec-list (cdr spec-list))))) 261 262(defun gamegrid-make-glyph (data-spec-list color-spec-list) 263 (let ((data (gamegrid-match-spec-list data-spec-list)) 264 (color (gamegrid-match-spec-list color-spec-list))) 265 (cond ((gamegrid-characterp data) 266 (vector data)) 267 ((eq data 'colorize) 268 (gamegrid-colorize-glyph color)) 269 ((listp data) 270 (find-image data)) ;untested! 271 ((vectorp data) 272 (gamegrid-make-image-from-vector data))))) 273 274(defun gamegrid-make-image-from-vector (vect) 275 "Convert an XEmacs style \"glyph\" to an image-spec." 276 (let ((l (list 'image :type))) 277 (dotimes (n (length vect)) 278 (setf l (nconc l (list (aref vect n))))) 279 (nconc l (list :ascent 'center)))) 280 281(defun gamegrid-display-type () 282 (cond ((and gamegrid-use-glyphs 283 (display-images-p)) 284 'glyph) 285 ((and gamegrid-use-color 286 (display-graphic-p) 287 (display-color-p)) 288 'color-x) 289 ((display-graphic-p) 290 'mono-x) 291 ((and gamegrid-use-color 292 (display-color-p)) 293 'color-tty) 294 ((display-multi-font-p) ;??? 295 'mono-tty) 296 (t 297 'emacs-tty))) 298 299(defun gamegrid-set-display-table () 300 (if (featurep 'xemacs) 301 (add-spec-to-specifier current-display-table 302 gamegrid-display-table 303 (current-buffer) 304 nil 305 'remove-locale) 306 (setq buffer-display-table gamegrid-display-table))) 307 308(defun gamegrid-setup-default-font () 309 (setq gamegrid-face 310 (copy-face 'default 311 (intern (concat "gamegrid-face-" (buffer-name))))) 312 (when (eq gamegrid-display-mode 'glyph) 313 (let ((max-height nil)) 314 (loop for c from 0 to 255 do 315 (let ((glyph (aref gamegrid-display-table c))) 316 (when (and (listp glyph) (eq (car glyph) 'image)) 317 (let ((height (cdr (image-size glyph)))) 318 (if (or (null max-height) 319 (< max-height height)) 320 (setq max-height height)))))) 321 (when (and max-height (< max-height 1)) 322 (set-face-attribute gamegrid-face nil :height max-height))))) 323 324(defun gamegrid-initialize-display () 325 (setq gamegrid-display-mode (gamegrid-display-type)) 326 (setq gamegrid-display-table (make-display-table)) 327 (setq gamegrid-face-table (make-vector 256 nil)) 328 (loop for c from 0 to 255 do 329 (let* ((spec (aref gamegrid-display-options c)) 330 (glyph (gamegrid-make-glyph (car spec) (caddr spec))) 331 (face (gamegrid-make-face (cadr spec) (caddr spec)))) 332 (aset gamegrid-face-table c face) 333 (aset gamegrid-display-table c glyph))) 334 (gamegrid-setup-default-font) 335 (gamegrid-set-display-table) 336 (setq cursor-type nil)) 337 338 339(defun gamegrid-set-face (c) 340 (if (eq gamegrid-display-mode 'glyph) 341 (add-text-properties (1- (point)) (point) 342 (list 'display (list (aref gamegrid-display-table c)))) 343 (put-text-property (1- (point)) 344 (point) 345 'face 346 (aref gamegrid-face-table c)))) 347 348(defun gamegrid-cell-offset (x y) 349 (+ gamegrid-buffer-start 350 (* (1+ gamegrid-buffer-width) y) 351 x)) 352 353;; ;;;;;;;;;;;;;;;; grid functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 354 355(defun gamegrid-get-cell (x y) 356 (char-after (gamegrid-cell-offset x y))) 357 358(defun gamegrid-set-cell (x y c) 359 (save-excursion 360 (let ((buffer-read-only nil)) 361 (goto-char (gamegrid-cell-offset x y)) 362 (delete-char 1) 363 (insert-char c 1) 364 (gamegrid-set-face c)))) 365 366(defun gamegrid-init-buffer (width height blank) 367 (setq gamegrid-buffer-width width 368 gamegrid-buffer-height height) 369 (let ((line (concat 370 (make-string width blank) 371 "\n")) 372 (buffer-read-only nil)) 373 (erase-buffer) 374 (setq gamegrid-buffer-start (point)) 375 (dotimes (i height) 376 (insert line)) 377 ;; Adjust the height of the default face to the height of the 378 ;; images. Unlike XEmacs, Emacs doesn't allow to make the default 379 ;; face buffer-local; so we do this with an overlay. 380 (when (eq gamegrid-display-mode 'glyph) 381 (overlay-put (make-overlay (point-min) (point-max)) 382 'face gamegrid-face)) 383 (goto-char (point-min)))) 384 385(defun gamegrid-init (options) 386 (setq buffer-read-only t 387 truncate-lines t 388 gamegrid-display-options options) 389 (buffer-disable-undo (current-buffer)) 390 (gamegrid-initialize-display)) 391 392;; ;;;;;;;;;;;;;;;; timer functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 393 394(defun gamegrid-start-timer (period func) 395 (setq gamegrid-timer 396 (if (featurep 'itimer) 397 (start-itimer "Gamegrid" 398 func 399 period 400 period 401 nil 402 t 403 (current-buffer)) 404 (run-with-timer period 405 period 406 func 407 (current-buffer))))) 408 409(defun gamegrid-set-timer (delay) 410 (if gamegrid-timer 411 (if (fboundp 'set-itimer-restart) 412 (set-itimer-restart gamegrid-timer delay) 413 (timer-set-time gamegrid-timer 414 (list (aref gamegrid-timer 1) 415 (aref gamegrid-timer 2) 416 (aref gamegrid-timer 3)) 417 delay)))) 418 419(defun gamegrid-kill-timer () 420 (if gamegrid-timer 421 (if (featurep 'itimer) 422 (delete-itimer gamegrid-timer) 423 (cancel-timer gamegrid-timer))) 424 (setq gamegrid-timer nil)) 425 426;; ;;;;;;;;;;;;;;; high score functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 427 428(defun gamegrid-add-score (file score) 429 "Add the current score to the high score file. 430 431On POSIX systems there may be a shared game directory for all users in 432which the scorefiles are kept. On such systems Emacs doesn't create 433the score file FILE in this directory, if it doesn't already exist. In 434this case Emacs searches for FILE in the directory specified by 435`gamegrid-user-score-file-directory' and creates it there, if 436necessary. 437 438To add the score file for a game to the system wide shared game 439directory, create the file with the shell command \"touch\" in this 440directory and make sure that it is owned by the correct user and 441group. You probably need special user privileges to do this. 442 443On non-POSIX systems Emacs searches for FILE in the directory 444specified by the variable `temporary-file-directory'. If necessary, 445FILE is created there." 446 (case system-type 447 ((ms-dos windows-nt) 448 (gamegrid-add-score-insecure file score)) 449 (t 450 (gamegrid-add-score-with-update-game-score file score)))) 451 452 453;; On POSIX systems there are four cases to distinguish: 454 455;; 1. FILE is an absolute filename. Then it should be a file in 456;; temporary file directory. This is the way, 457;; `gamegrid-add-score' was supposed to be used in the past and 458;; is covered here for backward-compatibility. 459;; 460;; 2. The helper program "update-game-score" is setuid and the 461;; file FILE does already exist in a system wide shared game 462;; directory. This should be the normal case on POSIX systems, 463;; if the game was installed system wide. Use 464;; "update-game-score" to add the score to the file in the 465;; shared game directory. 466;; 467;; 3. "update-game-score" is setuid, but the file FILE does *not* 468;; exist in the system wide shared game directory. Use 469;; `gamegrid-add-score-insecure' to create--if necessary--and 470;; update FILE. This is for the case that a user has installed 471;; a game on her own. 472;; 473;; 4. "update-game-score" is not setuid. Use it to create/update 474;; FILE in the user's home directory. There is presumably no 475;; shared game directory. 476 477(defvar gamegrid-shared-game-dir) 478 479(defun gamegrid-add-score-with-update-game-score (file score) 480 (let* ((result nil) ;; What is this good for? -- os 481 (gamegrid-shared-game-dir 482 (not (zerop (logand (file-modes 483 (expand-file-name "update-game-score" 484 exec-directory)) 485 #o4000))))) 486 (cond ((file-name-absolute-p file) 487 (gamegrid-add-score-insecure file score)) 488 ((and gamegrid-shared-game-dir 489 (file-exists-p (expand-file-name file shared-game-score-directory))) 490 ;; Use the setuid "update-game-score" program to update a 491 ;; system-wide score file. 492 (gamegrid-add-score-with-update-game-score-1 file 493 (expand-file-name file shared-game-score-directory) score)) 494 ;; Else: Add the score to a score file in the user's home 495 ;; directory. 496 (gamegrid-shared-game-dir 497 ;; If `gamegrid-shared-game-dir' is non-nil, then 498 ;; "update-gamescore" program is setuid, so don't use it. 499 (unless (file-exists-p 500 (directory-file-name gamegrid-user-score-file-directory)) 501 (make-directory gamegrid-user-score-file-directory t)) 502 (gamegrid-add-score-insecure file score 503 gamegrid-user-score-file-directory)) 504 (t (let ((f (expand-file-name 505 gamegrid-user-score-file-directory))) 506 (when (file-writable-p f) 507 (unless (eq (car-safe (file-attributes f)) 508 t) 509 (make-directory f)) 510 (setq f (expand-file-name file f)) 511 (unless (file-exists-p f) 512 (write-region "" nil f nil 'silent nil 'excl))) 513 (gamegrid-add-score-with-update-game-score-1 file f score)))))) 514 515(defun gamegrid-add-score-with-update-game-score-1 (file target score) 516 (let ((default-directory "/") 517 (errbuf (generate-new-buffer " *update-game-score loss*")) 518 (marker-string (concat 519 (user-full-name) 520 " <" 521 (cond ((fboundp 'user-mail-address) 522 (user-mail-address)) 523 ((boundp 'user-mail-address) 524 user-mail-address) 525 (t "")) 526 "> " 527 (current-time-string)))) 528 ;; This can be called from a timer, so enable local quits. 529 (with-local-quit 530 (apply 531 'call-process 532 (append 533 (list 534 (expand-file-name "update-game-score" exec-directory) 535 nil errbuf nil 536 "-m" (int-to-string gamegrid-score-file-length) 537 "-d" (if gamegrid-shared-game-dir 538 (expand-file-name shared-game-score-directory) 539 (file-name-directory target)) 540 file 541 (int-to-string score) 542 marker-string)))) 543 (if (buffer-modified-p errbuf) 544 (progn 545 (display-buffer errbuf) 546 (error "Failed to update game score file")) 547 (kill-buffer errbuf)) 548 (let ((buf (find-buffer-visiting target))) 549 (save-excursion 550 (if buf 551 (progn 552 (switch-to-buffer buf) 553 (revert-buffer nil t nil) 554 (display-buffer buf)) 555 (find-file-read-only target)) 556 (goto-char (point-min)) 557 (search-forward (concat (int-to-string score) 558 " " (user-login-name) " " 559 marker-string)) 560 (beginning-of-line))))) 561 562(defun gamegrid-add-score-insecure (file score &optional directory) 563 (save-excursion 564 (setq file (expand-file-name file (or directory 565 temporary-file-directory))) 566 (find-file-other-window file) 567 (setq buffer-read-only nil) 568 (goto-char (point-max)) 569 (insert (format "%05d\t%s\t%s <%s>\n" 570 score 571 (current-time-string) 572 (user-full-name) 573 (cond ((fboundp 'user-mail-address) 574 (user-mail-address)) 575 ((boundp 'user-mail-address) 576 user-mail-address) 577 (t "")))) 578 (sort-fields 1 (point-min) (point-max)) 579 (reverse-region (point-min) (point-max)) 580 (goto-line (1+ gamegrid-score-file-length)) 581 (delete-region (point) (point-max)) 582 (setq buffer-read-only t) 583 (save-buffer))) 584 585 586;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 587 588(provide 'gamegrid) 589 590;;; arch-tag: a96c2ff4-1c12-427e-bd3d-faeaf174cd46 591;;; gamegrid.el ends here 592