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.

2 files changed, 150 insertions, 35 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 5c6c0b7f2a0..ec52460f776 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -82,6 +82,13 @@ globally or for individual definitions.
 the XTerm window title.  This feature is experimental and is disabled
 by default.
 
+** Gamegrid
+
+---
+*** Gamegrid now determines its default glyph size based on display
+dimensions, instead of always using 16 pixels. As a result, Tetris,
+Snake and Pong are more playable on HiDPI displays.
+
 
 * New Modes and Packages in Emacs 27.1
 
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index 6214e07506d..641ef7f2462 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -86,49 +86,157 @@ directory will be used.")
 (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 @@ static unsigned char gamegrid_bits[] = {
        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)))))