diff options
Diffstat (limited to 'lisp/play/gamegrid.el')
| -rw-r--r-- | lisp/play/gamegrid.el | 301 |
1 files changed, 188 insertions, 113 deletions
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 7999194207b..2d19c145b0a 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -1,4 +1,4 @@ -;;; gamegrid.el --- library for implementing grid-based games on Emacs +;;; gamegrid.el --- library for implementing grid-based games on Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1997-1998, 2001-2019 Free Software Foundation, Inc. @@ -86,66 +86,165 @@ directory will be used.") (defvar gamegrid-mono-x-face nil) (defvar gamegrid-mono-tty-face nil) -;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar gamegrid-glyph-height-mm 7.0 + "Desired glyph height in mm.") -(defconst gamegrid-glyph-height 16) +;; ;;;;;;;;;;;;; glyph generation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst gamegrid-xpm "\ +(defun gamegrid-calculate-glyph-size () + "Calculate appropriate glyph size in pixels based on display resolution. +Return a multiple of 8 no less than 16." + (if (and (display-pixel-height) (display-mm-height)) + (let* ((y-pitch (/ (display-pixel-height) (float (display-mm-height)))) + (pixels (* y-pitch gamegrid-glyph-height-mm)) + (rounded (* (floor (/ (+ pixels 4) 8)) 8))) + (max 16 rounded)) + 16)) + +;; Example of glyph in XPM format: +;; +;; /* XPM */ +;; static char *noname[] = { +;; /* width height ncolors chars_per_pixel */ +;; \"16 16 3 1\", +;; /* colors */ +;; \"+ s col1\", +;; \". s col2\", +;; \"- s col3\", +;; /* pixels */ +;; \"---------------+\", +;; \"--------------++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"--............++\", +;; \"-+++++++++++++++\", +;; \"++++++++++++++++\" +;; }; + +(defun gamegrid-xpm () + "Generate the XPM format image used for each square." + (let* ((glyph-pixel-count (gamegrid-calculate-glyph-size)) + (border-pixel-count (/ glyph-pixel-count 8)) + (center-pixel-count (- glyph-pixel-count (* border-pixel-count 2)))) + (with-temp-buffer + (insert (format "\ /* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ -\"16 16 3 1\", +\"%s %s 3 1\", /* colors */ \"+ s col1\", \". s col2\", \"- s col3\", /* pixels */ -\"---------------+\", -\"--------------++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"--............++\", -\"-+++++++++++++++\", -\"++++++++++++++++\" -}; -" - "XPM format image used for each square") - -(defvar gamegrid-xbm "\ +" glyph-pixel-count glyph-pixel-count)) + + (dotimes (row border-pixel-count) + (let ((edge-pixel-count (+ row 1))) + (insert "\"") + (dotimes (_ (- glyph-pixel-count edge-pixel-count)) (insert "-")) + (dotimes (_ edge-pixel-count) (insert "+")) + (insert "\",\n"))) + + (let ((middle (format "\"%s%s%s\",\n" + (make-string border-pixel-count ?-) + (make-string center-pixel-count ?.) + (make-string border-pixel-count ?+)))) + (dotimes (_ center-pixel-count) (insert middle))) + + (dotimes (row border-pixel-count) + (let ((edge-pixel-count (- border-pixel-count row 1))) + (insert "\"") + (dotimes (_ edge-pixel-count) (insert "-")) + (dotimes (_ (- glyph-pixel-count edge-pixel-count)) (insert "+")) + (insert "\"") + (if (/= row (1- border-pixel-count)) + (insert ",\n") + (insert "\n};\n")))) + (buffer-string)))) + +;; Example of glyph in XBM format: +;; +;; /* gamegrid XBM */ +;; #define gamegrid_width 16 +;; #define gamegrid_height 16 +;; static unsigned char gamegrid_bits[] = { +;; 0xff, 0xff, 0xff, 0x7f, 0xff, 0x3f, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, +;; 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, +;; 0x57, 0x15, 0x07, 0x00, 0x03, 0x00, 0x01, 0x00 }; + +(defun gamegrid-xbm () + "Generate XBM format image used for each square." + (let* ((glyph-pixel-count (gamegrid-calculate-glyph-size)) + (border-pixel-count (1- (/ glyph-pixel-count 4))) + (center-pixel-count (- glyph-pixel-count (* 2 border-pixel-count)))) + (with-temp-buffer + (insert (format "\ /* gamegrid XBM */ -#define gamegrid_width 16 -#define gamegrid_height 16 +#define gamegrid_width %s +#define gamegrid_height %s static unsigned char gamegrid_bits[] = { - 0xff, 0xff, 0xff, 0x7f, 0xff, 0x3f, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, - 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, - 0x57, 0x15, 0x07, 0x00, 0x03, 0x00, 0x01, 0x00 };" - "XBM format image used for each square.") +" glyph-pixel-count glyph-pixel-count)) + (dotimes (row border-pixel-count) + (gamegrid-insert-xbm-bits + (concat (make-string (- glyph-pixel-count row) ?1) + (make-string row ?0))) + (insert ", \n")) + + (let* ((left-border (make-string border-pixel-count ?1)) + (right-border (make-string border-pixel-count ?0)) + (even-line (apply 'concat + (append (list left-border) + (make-list (/ center-pixel-count 2) "10") + (list right-border)))) + (odd-line (apply 'concat + (append (list left-border) + (make-list (/ center-pixel-count 2) "01") + (list right-border))))) + (dotimes (row center-pixel-count) + (gamegrid-insert-xbm-bits (if (eq (logand row 1) 1) odd-line even-line)) + (insert ", \n"))) + + (dotimes (row border-pixel-count) + (let ((edge-pixel-count (- border-pixel-count row))) + (gamegrid-insert-xbm-bits + (concat (make-string edge-pixel-count ?1) + (make-string (- glyph-pixel-count edge-pixel-count) ?0)))) + (if (/= row (1- border-pixel-count)) + (insert ", \n") + (insert " };\n"))) + (buffer-string)))) + +(defun gamegrid-insert-xbm-bits (str) + "Convert binary to hex and insert in current buffer. +STR should be a string composed of 1s and 0s and be a multiple of +8 in length. Divide it into 8 bit bytes, reverse the order of +each, convert them to hex and insert them in comma separated C +format." + (let ((byte-count (/ (length str) 8))) + (dotimes (i byte-count) + (let* ((byte (reverse (substring str (* i 8) (+ (* i 8) 8)))) + (value (string-to-number byte 2))) + (insert (format "0x%02x" value)) + (unless (= i (1- byte-count)) + (insert ", ")))))) ;; ;;;;;;;;;;;;;;;; miscellaneous functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defsubst gamegrid-characterp (arg) - (if (fboundp 'characterp) - (characterp arg) - (integerp arg))) - (defsubst gamegrid-event-x (event) - (if (fboundp 'event-x) - (event-x event) - (car (posn-col-row (event-end event))))) + (car (posn-col-row (event-end event)))) (defsubst gamegrid-event-y (event) - (if (fboundp 'event-y) - (event-y event) - (cdr (posn-col-row (event-end event))))) + (cdr (posn-col-row (event-end event)))) ;; ;;;;;;;;;;;;; display functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -210,31 +309,31 @@ static unsigned char gamegrid_bits[] = { (let ((data (gamegrid-match-spec-list data-spec-list)) (color (gamegrid-match-spec-list color-spec-list))) (pcase data - (`color-x + ('color-x (gamegrid-make-color-x-face color)) - (`grid-x + ('grid-x (unless gamegrid-grid-x-face (setq gamegrid-grid-x-face (gamegrid-make-grid-x-face))) gamegrid-grid-x-face) - (`mono-x + ('mono-x (unless gamegrid-mono-x-face (setq gamegrid-mono-x-face (gamegrid-make-mono-x-face))) gamegrid-mono-x-face) - (`color-tty + ('color-tty (gamegrid-make-color-tty-face color)) - (`mono-tty + ('mono-tty (unless gamegrid-mono-tty-face (setq gamegrid-mono-tty-face (gamegrid-make-mono-tty-face))) gamegrid-mono-tty-face)))) (defun gamegrid-colorize-glyph (color) - (find-image `((:type xpm :data ,gamegrid-xpm + (find-image `((:type xpm :data ,(gamegrid-xpm) :ascent center :color-symbols (("col1" . ,(gamegrid-color color 0.6)) ("col2" . ,(gamegrid-color color 0.8)) ("col3" . ,(gamegrid-color color 1.0)))) - (:type xbm :data ,gamegrid-xbm + (:type xbm :data ,(gamegrid-xbm) :ascent center :foreground ,(gamegrid-color color 1.0) :background ,(gamegrid-color color 0.5))))) @@ -257,7 +356,7 @@ static unsigned char gamegrid_bits[] = { (defun gamegrid-make-glyph (data-spec-list color-spec-list) (let ((data (gamegrid-match-spec-list data-spec-list)) (color (gamegrid-match-spec-list color-spec-list))) - (cond ((gamegrid-characterp data) + (cond ((characterp data) (vector data)) ((eq data 'colorize) (gamegrid-colorize-glyph color)) @@ -291,15 +390,6 @@ static unsigned char gamegrid_bits[] = { (t 'emacs-tty))) -(defun gamegrid-set-display-table () - (if (featurep 'xemacs) - (add-spec-to-specifier current-display-table - gamegrid-display-table - (current-buffer) - nil - 'remove-locale) - (setq buffer-display-table gamegrid-display-table))) - (declare-function image-size "image.c" (spec &optional pixels frame)) (defun gamegrid-setup-default-font () @@ -336,7 +426,7 @@ static unsigned char gamegrid_bits[] = { (aset gamegrid-face-table c face) (aset gamegrid-display-table c glyph))) (gamegrid-setup-default-font) - (gamegrid-set-display-table) + (setq buffer-display-table gamegrid-display-table) (setq cursor-type nil)) @@ -376,7 +466,7 @@ static unsigned char gamegrid_bits[] = { (buffer-read-only nil)) (erase-buffer) (setq gamegrid-buffer-start (point)) - (dotimes (i height) + (dotimes (_ height) (insert line)) ;; Adjust the height of the default face to the height of the ;; images. Unlike XEmacs, Emacs doesn't allow making the default @@ -398,34 +488,19 @@ static unsigned char gamegrid_bits[] = { (defun gamegrid-start-timer (period func) (setq gamegrid-timer - (if (featurep 'xemacs) - (start-itimer "Gamegrid" - func - period - period - nil - t - (current-buffer)) - (run-with-timer period - period - func - (current-buffer))))) + (run-with-timer period period func (current-buffer)))) (defun gamegrid-set-timer (delay) (if gamegrid-timer - (if (fboundp 'set-itimer-restart) - (set-itimer-restart gamegrid-timer delay) - (timer-set-time gamegrid-timer - (list (aref gamegrid-timer 1) - (aref gamegrid-timer 2) - (aref gamegrid-timer 3)) - delay)))) + (timer-set-time gamegrid-timer + (list (aref gamegrid-timer 1) + (aref gamegrid-timer 2) + (aref gamegrid-timer 3)) + delay))) (defun gamegrid-kill-timer () (if gamegrid-timer - (if (featurep 'xemacs) - (delete-itimer gamegrid-timer) - (cancel-timer gamegrid-timer))) + (cancel-timer gamegrid-timer)) (setq gamegrid-timer nil)) ;; ;;;;;;;;;;;;;;; high score functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -449,7 +524,7 @@ On non-POSIX systems Emacs searches for FILE in the directory specified by the variable `temporary-file-directory'. If necessary, FILE is created there." (pcase system-type - ((or `ms-dos `windows-nt) + ((or 'ms-dos 'windows-nt) (gamegrid-add-score-insecure file score)) (_ (gamegrid-add-score-with-update-game-score file score)))) @@ -457,8 +532,8 @@ FILE is created there." ;; On POSIX systems there are four cases to distinguish: -;; 1. FILE is an absolute filename. Then it should be a file in -;; temporary file directory. This is the way, +;; 1. FILE is an absolute filename or "update-game-score" does not exist. +;; Then FILE should be a file in a temporary file directory. This is how ;; `gamegrid-add-score' was supposed to be used in the past and ;; is covered here for backward-compatibility. ;; @@ -475,21 +550,18 @@ FILE is created there." ;; update FILE. This is for the case that a user has installed ;; a game on her own. ;; -;; 4. "update-game-score" does not exist or is not setgid/setuid. -;; Create/update FILE in the user's home directory, without -;; using "update-game-score". There is presumably no shared -;; game directory. +;; 4. "update-game-score" is not setgid/setuid. Use it to +;; create/update FILE in the user's home directory. There is +;; presumably no shared game directory. (defvar gamegrid-shared-game-dir) (defun gamegrid-add-score-with-update-game-score (file score) - (let ((gamegrid-shared-game-dir - (not (zerop (logand (or (file-modes - (expand-file-name "update-game-score" - exec-directory)) - 0) - #o6000))))) - (cond ((file-name-absolute-p file) + (let* ((update-game-score-modes + (file-modes (expand-file-name "update-game-score" exec-directory))) + (gamegrid-shared-game-dir + (not (zerop (logand #o6000 (or update-game-score-modes 0)))))) + (cond ((or (not update-game-score-modes) (file-name-absolute-p file)) (gamegrid-add-score-insecure file score)) ((and gamegrid-shared-game-dir (file-exists-p (expand-file-name file shared-game-score-directory))) @@ -499,25 +571,30 @@ FILE is created there." (expand-file-name file shared-game-score-directory) score)) ;; Else: Add the score to a score file in the user's home ;; directory. - (t + (gamegrid-shared-game-dir + ;; If gamegrid-shared-game-dir is non-nil the + ;; "update-gamescore" program is setuid, so don't use it. (unless (file-exists-p (directory-file-name gamegrid-user-score-file-directory)) (make-directory gamegrid-user-score-file-directory t)) (gamegrid-add-score-insecure file score - gamegrid-user-score-file-directory))))) + gamegrid-user-score-file-directory)) + (t + (unless (file-exists-p + (directory-file-name gamegrid-user-score-file-directory)) + (make-directory gamegrid-user-score-file-directory t)) + (let ((f (expand-file-name file + gamegrid-user-score-file-directory))) + (unless (file-exists-p f) + (write-region "" nil f nil 'silent nil 'excl)) + (gamegrid-add-score-with-update-game-score-1 file f score)))))) (defun gamegrid-add-score-with-update-game-score-1 (file target score) (let ((default-directory "/") (errbuf (generate-new-buffer " *update-game-score loss*")) (marker-string (concat (user-full-name) - " <" - (cond ((fboundp 'user-mail-address) - (user-mail-address)) - ((boundp 'user-mail-address) - user-mail-address) - (t "")) - "> " + " <" user-mail-address "> " (current-time-string)))) ;; This can be called from a timer, so enable local quits. (with-local-quit @@ -547,6 +624,7 @@ FILE is created there." (revert-buffer nil t nil) (display-buffer buf)) (find-file-read-only target)) + (view-mode) (goto-char (point-min)) (search-forward (concat (int-to-string score) " " (user-login-name) " " @@ -564,18 +642,15 @@ FILE is created there." score (current-time-string) (user-full-name) - (cond ((fboundp 'user-mail-address) - (user-mail-address)) - ((boundp 'user-mail-address) - user-mail-address) - (t "")))) + user-mail-address)) (sort-fields 1 (point-min) (point-max)) (reverse-region (point-min) (point-max)) (goto-char (point-min)) (forward-line gamegrid-score-file-length) (delete-region (point) (point-max)) (setq buffer-read-only t) - (save-buffer))) + (save-buffer) + (view-mode))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |