Re: gamegrid.el and some games

[Oliver Scholz <alkibiades@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 2149 bytes --]

Francesco Potorti` <pot@gnu.org> writes:

[...]
>    I have send a patch some time ago, which enables XPM (and PBM) for
>    gamegrid. (BTW what happend to this patch?) 
>
> Would you send it to me?  

O.K. Attached. The diff is against the version of gamegrid.el that
comes with Emacs 21.2. AFAICS there are some changes in the current
CVS. Could this cause problems? I am not familiar with diff & patch.

> I was just trying to do that.

*hehehe* I was quicker.
    
>    I guess gamegrid is mainly supposed to provide simple grids,
>    i.e. colored squares. 
>
> Yes, after some study I arrived to the same conclusion, so I further
> reduced my patch to pong.el, tetris.el, snake.el before installing it.
>
>                          The option to use characters is -- I guess --
>    intended only as a fallback on ttys without color. OTOH: it allows to
>    utilize arbitrary XPM images 
>
> Yes, for example pong could use a real ball.

Oh, that's easy:

(defvar pong-ball-glyph
"/* XPM */
static char * ball_xpm[] = {
\"16 16 4 1\",
\" 	c Black\",
\"+	c Red4\",
\"-	c Red1\",
\".	c Red\",
\"     ------     \",
\"   ----------   \",
\"  ----....--++  \",
\" ---........+++ \",
\" --..........++ \",
\"---..........+++\",
\"--............++\",
\"--............++\",
\"--............++\",
\"--............++\",
\"---..........+++\",
\" --..........++ \",
\" ---........+++ \",
\"  -+++....++++  \",
\"   ++++++++++   \",
\"     ++++++     \"};")

(defvar pong-ball-options
  `(((glyph [xpm :data ,pong-ball-glyph])
     (t ?\*))
    ((color-x color-x)
     (mono-x grid-x)
     (color-tty color-tty))
    (((glyph color-x) [1 0 0])
     (color-tty pong-ball-color))))

This reveals, however, a problem with my patch:

As I said, I use `display-images-p' and then `find-image' to get
either XPM or PBM; the latter AFAIU is supposed to be always available
if `display-images-p' returns t.

This is o.k. for all games that come with Emacs. But it could lead to
unexpected results for packages like sokoban.el or for pong if you add
the image above: if an Emacs is compiled without support for XPM,
there is no PBM as a fall-back.

    -- Oliver


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: gamegrid.diff --]
[-- Type: text/x-patch, Size: 7394 bytes --]

--- /usr/local/share/emacs/21.2/lisp/play/gamegrid.el	Tue May  7 23:18:49 2002
+++ gamegrid.el	Mon Jul 22 00:46:33 2002
@@ -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)
@@ -115,6 +119,16 @@
 "
   "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)
@@ -145,7 +159,7 @@
   (if gamegrid-font
       (condition-case nil
 	  (set-face-font face gamegrid-font)
-	('error nil))))
+	(error nil))))
 
 (defun gamegrid-setup-face (face color)
   (set-face-foreground face color)
@@ -153,23 +167,23 @@
   (gamegrid-set-font face)
   (condition-case nil
       (set-face-background-pixmap face [nothing]);; XEmacs
-    ('error nil))
+    (error nil))
   (condition-case nil
       (set-face-background-pixmap face nil);; Emacs
-    ('error nil)))
+    (error nil)))
 
 (defun gamegrid-make-mono-tty-face ()
   (let ((face (make-face 'gamegrid-mono-tty-face)))
     (condition-case nil
 	(set-face-property face 'reverse t)
-      ('error nil))
+      (error nil))
     face))
 
 (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))
 
 (defun gamegrid-make-grid-x-face ()
@@ -215,13 +229,16 @@
        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))
@@ -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)))))
 
-(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))
-	     (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)))
 
 (defun gamegrid-set-display-table ()
   (if (fboundp 'specifierp)
@@ -287,26 +301,21 @@
 			     'remove-locale)
     (setq buffer-display-table gamegrid-display-table)))
 
-(defun gamegrid-hide-cursor ()
-  (if (fboundp 'specifierp)
-      (set-specifier text-cursor-visible-p nil (current-buffer))))
-
 (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))
@@ -320,11 +329,13 @@
       (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
@@ -351,14 +362,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))))
 
 (defun gamegrid-init (options)

[-- Attachment #3: Type: text/plain, Size: 72 bytes --]


-- 
28 Fructidor an 210 de la Révolution
Liberté, Egalité, Fraternité!