Use lexical-binding in life.el and add tests

* lisp/play/life.el: Use lexical-binding.
(life--tick): Extract from...
(life): ...here.
(life--max-width, life--max-height): New variables.
(life-mode, life-setup): Use above variables.

* test/lisp/play/life-tests.el: New file.

diff --git a/lisp/play/life.el b/lisp/play/life.el
index a7247be8508c177464a60a1c3831a0cf0c3c4d95..56ecc5273da4215567d8f79cc4810fee2d79aab3 100644 (file)
--- a/lisp/play/life.el
+++ b/lisp/play/life.el
@@ -1,4 +1,4 @@
-;;; life.el --- John Horton Conway's `Life' game for GNU Emacs
+;;; life.el --- John Horton Conway's Game of Life  -*- lexical-binding:t -*-
 
 ;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc.
 
@@ -135,11 +135,25 @@
 ;; (scroll-up) and (scroll-down) when trying to center the display.
 (defvar life-window-start nil)
 
+(defvar life--max-width nil
+  "If non-nil, restrict width to this positive integer. ")
+
+(defvar life--max-height nil
+  "If non-nil, restrict height to this positive integer. ")
+
 ;; For mode line
 (defvar life-current-generation nil)
 ;; Sadly, mode-line-format won't display numbers.
 (defvar life-generation-string nil)
 
+(defun life--tick ()
+  "Game tick for `life'."
+  (let ((inhibit-quit t)
+        (inhibit-read-only t))
+    (life-grim-reaper)
+    (life-expand-plane-if-needed)
+    (life-increment-generation)))
+
 ;;;###autoload
 (defun life (&optional step-time)
   "Run Conway's Life simulation.
@@ -158,12 +172,8 @@ sleep in seconds."
   (life-setup)
   (catch 'life-exit
     (while t
-      (let ((inhibit-quit t)
-           (inhibit-read-only t))
-        (life-display-generation step-time)
-       (life-grim-reaper)
-       (life-expand-plane-if-needed)
-       (life-increment-generation)))))
+      (life-display-generation step-time)
+      (life--tick))))
 
 (define-derived-mode life-mode special-mode "Life"
   "Major mode for the buffer of `life'."
@@ -174,7 +184,8 @@ sleep in seconds."
   (setq-local life-generation-string "0")
   (setq-local mode-line-buffer-identification '("Life: generation "
                                                 life-generation-string))
-  (setq-local fill-column (1- (window-width)))
+  (setq-local fill-column (min (or life--max-width most-positive-fixnum)
+                               (1- (window-width))))
   (setq-local life-window-start 1)
   (buffer-disable-undo))
 
@@ -196,7 +207,8 @@ sleep in seconds."
        (indent-to n)
        (forward-line)))
     ;; center the pattern vertically
-    (let ((n (/ (- (1- (window-height))
+    (let ((n (/ (- (min (or life--max-height most-positive-fixnum)
+                        (1- (window-height)))
                   (count-lines (point-min) (point-max)))
                2)))
       (goto-char (point-min))

diff --git a/test/lisp/play/life-tests.el b/test/lisp/play/life-tests.el
new file mode 100644 (file)
index 0000000..38726bb
--- /dev/null
+++ b/test/lisp/play/life-tests.el
@@ -0,0 +1,80 @@
+;;; life-tests.el --- Tests for life.el  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Stefan Kangas <stefankangas@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'life)
+
+(ert-deftest test-life ()
+  (let ((life--max-width 5)
+        (life--max-height 3)
+        (life-patterns [(" @ "
+                     "  @"
+                     "@@@")])
+        (generations '("
+
+  @
+   @
+ @@@
+" "
+
+
+ @ @
+  @@
+  @
+" "
+
+
+   @
+ @ @
+  @@
+" "
+
+
+  @
+   @@
+  @@
+" "
+
+
+   @
+    @
+  @@@
+"
+)))
+    (life-setup)
+    ;; Test initial state.
+    (goto-char (point-min))
+    (dolist (generation generations)
+      ;; Hack to test buffer contents without trailing whitespace,
+      ;; while also not modifying the "*Life*" buffer.
+      (let ((str (buffer-string))
+            (delete-trailing-lines t))
+        (with-temp-buffer
+          (insert str)
+          (delete-trailing-whitespace)
+          (should (equal (buffer-string) generation))))
+      (life--tick))))
+
+(provide 'life-tests)
+
+;;; life-tests.el ends here