bug#24658: 26.0.50; gamegrid on HiDPI displays (feature request)

[Gemini Lasswell]

Tamas Papp <tkpapp@gmail.com> writes:

> Games that use gamegrid (snake, tetris, pong) are hard to see on
> high-resolution laptop display (eg 3200x1800) --- it looks like the cell
> size is hardcoded as 16.

Here's a patch which makes gamegrid change its grid size based on
display dimensions. Its target is an on-screen size of 7mm, which
works well on the various displays I have. Let me know how it looks on
yours. Changing gamegrid-glyph-height-mm before starting one of the
games will let you experiment.

Emacs Developers,
Should I include a NEWS entry about the effect on Tetris/Snake/Pong
instead of or in addition to the one about gamegrid-glyph-height? And
is this patch appropriate for release or master at this point?


>From 1a8876bac69627bc1bb8fb9498100b8dc283723a Mon Sep 17 00:00:00 2001
From: Gemini Lasswell <gazally@runbox.com>
Date: Mon, 16 Oct 2017 08:30:51 -0700
Subject: [PATCH] Make Snake, Tetris and Pong adjust to display DPI

Replace gamegrid's constant 16x16 glyph with a generated one based
on display dimensions (bug#24658).
* lisp/play/gamegrid.el (gamegrid-glyph-height-mm): New variable.
(gamegrid-glyph-height): Deleted.
(gamegrid-xpm, gamegrid-xbm): Constants replaced with functions.
(gamegrid-colorize-glyph): Use new functions instead of constants.
(gamegrid-calculate-glyph-size, gamegrid-insert-xbm-bits): New
functions.
---
 etc/NEWS              |   7 ++
 lisp/play/gamegrid.el | 178 ++++++++++++++++++++++++++++++++++++++++----------
 2 files changed, 150 insertions(+), 35 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 2b2aa7c0f0..c7a9522d1f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1403,6 +1403,13 @@ them through 'format' first.  Even that is discouraged: 
for ElDoc
 support, you should set 'eldoc-documentation-function' instead of
 calling 'eldoc-message' directly.
 
+---
+** The constant 'gamegrid-glyph-height' has been deleted.  Gamegrid
+now calculates its glyph height based on display dimensions.  Use
+'gamegrid-calculate-glyph-height' to get the glyph height in pixels.
+Before calling it, you may set 'gamegrid-glyph-height-mm' to the
+desired on-screen glyph height in millimeters.
+
 
 * Lisp Changes in Emacs 26.1
 
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index 6214e07506..641ef7f246 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -86,49 +86,157 @@ gamegrid-grid-x-face
 (defvar gamegrid-mono-x-face nil)
 (defvar gamegrid-mono-tty-face nil)
 
-;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defconst gamegrid-glyph-height 16)
-
-(defconst gamegrid-xpm "\
+(defvar gamegrid-glyph-height-mm 7.0
+  "Desired glyph height in mm.")
+
+;; ;;;;;;;;;;;;; glyph generation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -228,13 +336,13 @@ gamegrid-make-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)))))
-- 
2.14.2