From 0f7df8ac6ab7428289445a1109413d628f2a884a Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 23 Sep 2002 16:03:03 +0000 Subject: [PATCH] (gamegrid-face): new variable to emulate a buffer-local default face. (gamegrid-xbm): new variable; XBM image as a replacement for `gamegrid-xpm' on Emacsen compiled without XPM-support. (gamegrid-colorize-glyph): Ported XEmacs-code for the generation of images to Emacs. (gamegrid-match-spec): Call `gamegrid-make-image-from-vector' to convert XEmacs-type image descriptors. (gamegrid-color-display-p): Removed. (Use `display-colors-p' instead.) (gamegrid-make-image-from-vector): New function. Convert XEmacs' image descriptors. (gamegrid-display-type): Use Emacs' standard `display-.*-p' functions to check for display capabilities. Fix the recognition of image-support in Emacs 21 by this way. (gamegrid-hide-cursor): Removed. (gamegrid-setup-default-font): Ported the code from XEmacs to Emacs: create a new face and assign the variable `gamegrid-face' to it. Make sure that the face is not higher than the smallest image used by the game. (gamegrid-initialize-display): Use `(setq cursor-type nil)' instead of `gamegrid-hide-cursor'. (gamegrid-set-face): If `gamegrid-display-mode' is 'glyph, put an image in the buffer, instead of applying a face. (gamegrid-init-buffer): If `gamegrid-display-mode' is 'glyph, put the face held by `gamegrid-face' in an overlay over the whole buffer to emulate a buffer-local default-face. --- lisp/play/gamegrid.el | 127 +++++++++++++++++++++++++++++--------------------- 1 file changed, 73 insertions(+), 54 deletions(-) diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index b8f7050ed00..f21db937dc6 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -42,6 +42,10 @@ (defvar gamegrid-font "-*-courier-medium-r-*-*-*-140-100-75-*-*-iso8859-*" "Name of the font used in X mode.") +(defvar gamegrid-face nil + "Indicates the face to use as a default.") +(make-variable-buffer-local 'gamegrid-face) + (defvar gamegrid-display-options nil) (defvar gamegrid-buffer-width 0) @@ -120,6 +124,16 @@ static char *noname[] = { " "XPM format image used for each square") +(defvar gamegrid-xbm "\ +/* 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 };" + "XBM format image used for each square.") + ;; ;;;;;;;;;;;;;;;; miscellaneous functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defsubst gamegrid-characterp (arg) @@ -220,13 +234,16 @@ static char *noname[] = { gamegrid-mono-tty-face)))) (defun gamegrid-colorize-glyph (color) - (make-glyph - (vector - 'xpm - :data gamegrid-xpm - :color-symbols (list (cons "col1" (gamegrid-color color 0.6)) - (cons "col2" (gamegrid-color color 0.8)) - (cons "col3" (gamegrid-color color 1.0)))))) + (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 + :ascent center + :foreground ,(gamegrid-color color 1.0) + :background ,(gamegrid-color color 0.5))))) (defun gamegrid-match-spec (spec) (let ((locale (car spec)) @@ -250,36 +267,35 @@ static char *noname[] = { (vector data)) ((eq data 'colorize) (gamegrid-colorize-glyph color)) + ((listp data) + (find-image data)) ;untested! ((vectorp data) - (make-glyph data))))) + (gamegrid-make-image-from-vector data))))) -(defun gamegrid-color-display-p () - (if (fboundp 'device-class) - (eq (device-class (selected-device)) 'color) - (eq (cdr-safe (assq 'display-type (frame-parameters))) 'color))) +(defun gamegrid-make-image-from-vector (vect) + "Convert an XEmacs style \"glyph\" to an image-spec." + (let ((l (list 'image :type))) + (dotimes (n (length vect)) + (setf l (nconc l (list (aref vect n))))) + (nconc l (list :ascent 'center)))) (defun gamegrid-display-type () - (let ((window-system-p - (or (and (fboundp 'console-on-window-system-p) - (console-on-window-system-p)) - window-system))) - (cond ((and gamegrid-use-glyphs - window-system-p - (featurep 'xpm)) - 'glyph) - ((and gamegrid-use-color - window-system-p - (gamegrid-color-display-p)) - 'color-x) - (window-system-p - 'mono-x) - ((and gamegrid-use-color - (gamegrid-color-display-p)) - 'color-tty) - ((fboundp 'set-face-property) - 'mono-tty) - (t - 'emacs-tty)))) + (cond ((and gamegrid-use-glyphs + (display-images-p)) + 'glyph) + ((and gamegrid-use-color + (display-graphic-p) + (display-color-p)) + 'color-x) + ((display-graphic-p) + 'mono-x) + ((and gamegrid-use-color + (display-color-p)) + 'color-tty) + ((display-multi-font-p) ;??? + 'mono-tty) + (t + 'emacs-tty))) (defun gamegrid-set-display-table () (if (fboundp 'specifierp) @@ -290,26 +306,21 @@ static char *noname[] = { 'remove-locale) (setq buffer-display-table gamegrid-display-table))) -(defun gamegrid-hide-cursor () - (make-local-variable 'cursor-type) - (setq cursor-type nil)) - (defun gamegrid-setup-default-font () - (cond ((eq gamegrid-display-mode 'glyph) - (let* ((font-spec (face-property 'default 'font)) - (name (font-name font-spec)) - (max-height nil)) - (loop for c from 0 to 255 do - (let ((glyph (aref gamegrid-display-table c))) - (cond ((glyphp glyph) - (let ((height (glyph-height glyph))) - (if (or (null max-height) - (< max-height height)) - (setq max-height height))))))) - (if max-height - (while (and (> (font-height font-spec) max-height) - (setq name (x-find-smaller-font name))) - (add-spec-to-specifier font-spec name (current-buffer)))))))) + (setq gamegrid-face + (copy-face 'default + (intern (concat "gamegrid-face-" (buffer-name))))) + (when (eq gamegrid-display-mode 'glyph) + (let ((max-height nil)) + (loop for c from 0 to 255 do + (let ((glyph (aref gamegrid-display-table c))) + (when (and (listp glyph) (eq (car glyph) 'image)) + (let ((height (cdr (image-size glyph)))) + (if (or (null max-height) + (< max-height height)) + (setq max-height height)))))) + (when (and max-height (< max-height 1)) + (set-face-attribute gamegrid-face nil :height max-height))))) (defun gamegrid-initialize-display () (setq gamegrid-display-mode (gamegrid-display-type)) @@ -323,11 +334,13 @@ static char *noname[] = { (aset gamegrid-display-table c glyph))) (gamegrid-setup-default-font) (gamegrid-set-display-table) - (gamegrid-hide-cursor)) + (setq cursor-type nil)) (defun gamegrid-set-face (c) - (unless (eq gamegrid-display-mode 'glyph) + (if (eq gamegrid-display-mode 'glyph) + (add-text-properties (1- (point)) (point) + (list 'display (list (aref gamegrid-display-table c)))) (put-text-property (1- (point)) (point) 'face @@ -362,6 +375,12 @@ static char *noname[] = { (setq gamegrid-buffer-start (point)) (dotimes (i height) (insert line)) + ;; Adjust the height of the default face to the height of the + ;; images. Unlike XEmacs, Emacs doesn't allow to make the default + ;; face buffer-local; so we do this with an overlay. + (when (eq gamegrid-display-mode 'glyph) + (overlay-put (make-overlay (point-min) (point-max)) + 'face gamegrid-face)) (goto-char (point-min)))) (defun gamegrid-init (options) -- 2.11.4.GIT