From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Oliver Scholz Newsgroups: gmane.emacs.devel Subject: [patch] XPM in gamegrid.el Date: Mon, 01 Jul 2002 16:01:22 +0200 Sender: emacs-devel-admin@gnu.org Message-ID: NNTP-Posting-Host: localhost.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: quoted-printable X-Trace: main.gmane.org 1025526611 10905 127.0.0.1 (1 Jul 2002 12:30:11 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 1 Jul 2002 12:30:11 +0000 (UTC) Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by main.gmane.org with esmtp (Exim 3.33 #1 (Debian)) id 17P0Jn-0002pm-00 for ; Mon, 01 Jul 2002 14:30:11 +0200 Original-Received: from fencepost.gnu.org ([199.232.76.164]) by quimby.gnus.org with esmtp (Exim 3.12 #1 (Debian)) id 17P0OK-0002ei-00 for ; Mon, 01 Jul 2002 14:34:52 +0200 Original-Received: from localhost ([127.0.0.1] helo=fencepost.gnu.org) by fencepost.gnu.org with esmtp (Exim 3.34 #1 (Debian)) id 17P0Jh-0000oA-00; Mon, 01 Jul 2002 08:30:05 -0400 Original-Received: from dialin-145-254-192-174.arcor-ip.net ([145.254.192.174] helo=localhost.localdomain) by fencepost.gnu.org with esmtp (Exim 3.34 #1 (Debian)) id 17P0HC-0000Xq-00 for ; Mon, 01 Jul 2002 08:27:31 -0400 Original-Received: (from egoge@localhost) by localhost.localdomain (8.11.4/8.11.4) id g61E1Nk08274; Mon, 1 Jul 2002 16:01:23 +0200 X-Authentication-Warning: localhost.localdomain: egoge set sender to epameinondas@gmx.de using -f Original-To: emacs-devel@gnu.org X-Operating-System: Linux from Scratch X-Attribution: os X-Face: "HgH2sgK|bfH$;PiOJI6|qUCf.ve<51_Od(%ynHr?=>znn#~#oS>",F%B8&\vus),2AsPYb -n>PgddtGEn}s7kH?7kH{P_~vu?]OvVN^qD(L)>G^gDCl(U9n{:d>'DkilN!_K"eNzjrtI4Ya6;Td% IZGMbJ{lawG+'J>QXPZD&TwWU@^~A}f^zAb[Ru;CT(UA]c& Original-Lines: 213 User-Agent: Gnus/5.090007 (Oort Gnus v0.07) Emacs/21.2 (i686-pc-linux-gnu) X-MIME-Autoconverted: from 8bit to quoted-printable by localhost.localdomain id g61E1Nk08274 Errors-To: emacs-devel-admin@gnu.org X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.0.11 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: Xref: main.gmane.org gmane.emacs.devel:5286 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:5286 Hello! The XPM stuff in gamegrid.el does not work in Emacs 21.2. Obviously it is meant for XEmacs. I have fixed this. With the following patch gamegrid packages like `snake' and `tetris' display the nice XPM grids. Furthermore: I have added XBM-grids for Emacsen that are not compiled with the XPM library. And very important: You can play Sokoban with graphics! :-) -- Oliver --- /usr/local/share/emacs/21.2/lisp/play/gamegrid.el Tue May 7 23:18:49= 2002 +++ gamegrid.el Mon Jul 1 15:45:24 2002 @@ -42,6 +42,10 @@ (defvar gamegrid-font "-*-courier-medium-r-*-*-*-140-100-75-*-*-iso8859-= *" "Name of the font used in X mode.") =20 +(defvar gamegrid-face nil + "Indicates the face to use as a default.") +(make-variable-buffer-local 'gamegrid-face) + (defvar gamegrid-display-options nil) =20 (defvar gamegrid-buffer-width 0) @@ -115,6 +119,16 @@ " "XPM format image used for each square") =20 +(defvar gamegrid-xbm "\ +/* gamegrid XBM */ +#define gamegrid_width 16 +#define gamegrid_height 16 +static unsigned char gamegrid_bits[] =3D { + 0xff, 0xff, 0xff, 0x7f, 0xff, 0x3f, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0= a, + 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0= a, + 0x57, 0x15, 0x07, 0x00, 0x03, 0x00, 0x01, 0x00 };" + "XBM format image used for each square.") + ;; ;;;;;;;;;;;;;;;; miscellaneous functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;= ;;;;;; =20 (defsubst gamegrid-characterp (arg) @@ -166,10 +180,10 @@ face)) =20 (defun gamegrid-make-color-tty-face (color) - (let* ((color-str (symbol-value color)) - (name (intern (format "gamegrid-color-tty-face-%s" color-str))) + (let* (;(color-str (symbol-value color)) + (name (intern (format "gamegrid-color-tty-face-%s" color))) (face (make-face name))) - (gamegrid-setup-face face color-str) + (gamegrid-setup-face face color) face)) =20 (defun gamegrid-make-grid-x-face () @@ -215,13 +229,16 @@ gamegrid-mono-tty-face)))) =20 (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=20 + (("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))))) =20 (defun gamegrid-match-spec (spec) (let ((locale (car spec)) @@ -245,38 +262,35 @@ (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))))) =20 -(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)))) =20 (defun gamegrid-display-type () - (let ((window-system-p=20 - (or (and (fboundp 'console-on-window-system-p) - (console-on-window-system-p)) - (and (fboundp 'display-color-p) - (display-color-p)) - window-system))) (cond ((and gamegrid-use-glyphs - window-system-p - (featurep 'xpm)) + (display-images-p)) 'glyph) ((and gamegrid-use-color - window-system-p - (gamegrid-color-display-p)) + (display-graphic-p) + (display-color-p)) 'color-x) - (window-system-p + ((display-graphic-p) 'mono-x) ((and gamegrid-use-color - (gamegrid-color-display-p)) + (display-color-p)) 'color-tty) - ((fboundp 'set-face-property) + ((display-multi-font-p) ;??? 'mono-tty) (t - 'emacs-tty)))) + 'emacs-tty))) =20 (defun gamegrid-set-display-table () (if (fboundp 'specifierp) @@ -292,21 +306,20 @@ (set-specifier text-cursor-visible-p nil (current-buffer)))) =20 (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))))) =20 (defun gamegrid-initialize-display () (setq gamegrid-display-mode (gamegrid-display-type)) @@ -324,7 +337,9 @@ =20 =20 (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 @@ -351,14 +366,18 @@ (defun gamegrid-init-buffer (width height blank) (setq gamegrid-buffer-width width gamegrid-buffer-height height) - (let ((line (concat - (make-string width blank) - "\n")) + (let ((line (concat (make-string width blank) "\n")) (buffer-read-only nil)) (erase-buffer) (setq gamegrid-buffer-start (point)) (dotimes (i height) - (insert-string line)) + (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)))) =20 (defun gamegrid-init (options) --=20 Oliver Scholz 13 Messidor an 210 de la R=E9volution Taunusstr. 25 Libert=E9, Egalit=E9, Fraternit=E9! 60329 Frankfurt a. M. Tel. (069) 97 40 99 42