~octaspire/crates2

869697f0deb688e57808de4a292c7e18f4be7f6f — octaspire a month ago ffeb9d4
Add initial automatic play testing feature

  * 'make test' runs automatic play test. It plays the game
    from start to finish automatically, without any user
    intervention and as fast as possible (without delays)
    and checks that everything looks as it should be.

    This play testing uses the textual ASCII "renderer", so this
    visual representation is tested at the same time and no
    graphical or TUI libraries are needed. Of course any 2D or 3D
    representation is not tested by this test, but as
    the different visual representations should be very
    simple (only show the current situation visually, possibly
    doing linear interpolation for the motion of crates), and all
    the logic and animating is done in inside the game, the game logic,
    animating and playability should be pretty comprehensively tested.
7 files changed, 178 insertions(+), 34 deletions(-)

A .builds/debian_stretch.yml
M Makefile
M doc/TODO.org
A etc/test.sh
M src/levels.lisp
M src/main.lisp
M src/textual.lisp
A .builds/debian_stretch.yml => .builds/debian_stretch.yml +16 -0
@@ 0,0 1,16 @@
image: debian/bullseye
packages:
    - build-essential
    - curl
    - sbcl
sources:
    - https://git.sr.ht/~octaspire/crates2
tasks:
    - setup: |
        curl -O https://beta.quicklisp.org/quicklisp.lisp
        sbcl --load quicklisp.lisp --eval '(quicklisp-quickstart:install)' --eval '(ql-util:without-prompting (ql:add-to-init-file))' --eval '(quit)'
        mkdir -p ~/.config/common-lisp/source-registry.conf.d/
        cp crates2/etc/crates2.conf ~/.config/common-lisp/source-registry.conf.d/crates2.conf
    - test: |
        cd crates2
        make test

M Makefile => Makefile +14 -10
@@ 16,7 16,7 @@ LISP  ?= sbcl
EVAL  ?= "--eval"
LOAD  ?= "--load

.PHONY: slime clean help
.PHONY: slime clean help test

crates2: Makefile crates2.asd src/*.lisp
	@$(LISP) $(EVAL) '(ql:quickload :crates2)' \


@@ 32,13 32,17 @@ run: crates2
clean:
	@rm -f crates2

test: crates2
	@etc/test.sh

help:
	@echo "Usage:"
	@echo "  make <target>"
	@echo ""
	@echo "Targets:"
	@echo "  crates2  build standalone binary executable for crates2 (default target)"
	@echo "  run      build standalone binary and run it"
	@echo "  slime    start Emacs/slime (if needed) with crates2 loaded"
	@echo "  clean    remove build artifacts"
	@echo "  help     show this help"
	@echo 'Usage:'
	@echo '  make <target>'
	@echo ''
	@echo 'Targets:'
	@echo '  crates2  build standalone binary executable for crates2 (default target)'
	@echo '  run      build standalone binary and run it'
	@echo '  slime    start Emacs/slime (if needed) with crates2 loaded'
	@echo '  clean    remove build artifacts'
	@echo '  test     build and do a play test'
	@echo '  help     show this help'

M doc/TODO.org => doc/TODO.org +2 -1
@@ 1,1 1,2 @@
Empty.
- Read regular user input in textual ASCII mode. Fake input
  is used while testing.

A etc/test.sh => etc/test.sh +50 -0
@@ 0,0 1,50 @@
#!/bin/sh
# Octaspire Crates 2 - Puzzle Game
# Copyright 2020, 2021 octaspire.com
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
OS=$(uname)
GOT_FILE='got.txt'
EXPECTED_FILE='expected.txt'
EXPECTED_ARCH="${EXPECTED_FILE}.bz2"
URL="https://octaspire.io/${EXPECTED_ARCH}"

rm -f "$GOT_FILE"

if [ "$OS" = "OpenBSD" ]
then
    echo "===================================================================================="
    echo "Running in OpenBSD. This script requires the following line in your /etc/doas.conf:"
    echo ""
    echo "permit nopass ${USER} as root cmd /bin/cp args crates2 /usr/local/bin/"
    echo ""
    echo "If this script doesn't work, please add the above line to your /etc/doas.conf."
    echo "Or copy the executable to /usr/local/bin manually. This is because of the W^X"
    echo "protection that OpenBSD uses."
    echo "===================================================================================="
    doas /bin/cp crates2 /usr/local/bin/
    /usr/local/bin/crates2 --test 0 > "$GOT_FILE"
else
    ./crates2 --test 0  > "$GOT_FILE"
fi

if test -e "$EXPECTED_ARCH"
then
    curl -o "$EXPECTED_ARCH" -z "$EXPECTED_ARCH" "$URL"
else
    curl -o "$EXPECTED_ARCH" "$URL"
fi


bunzip2 -fk "$EXPECTED_ARCH"
diff "$GOT_FILE" "$EXPECTED_FILE"

M src/levels.lisp => src/levels.lisp +65 -8
@@ 14,7 14,7 @@
;; limitations under the License.
(in-package :crates2)

(defparameter *num-levels* 18)
(defparameter *num-levels* 19)

(defun load-level (index)
  (ecase index


@@ 57,13 57,13 @@
                   (make-instance 'slope-ws :x 14 :y 2  :z 0)
                   (make-instance 'slope-wn :x 14 :y 6  :z 0)
                   (make-instance 'player   :x 8  :y 6 :z 0))))
    (9 (list (list :west nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil)
    (9 (list (list :west nil nil nil nil nil nil nil nil nil nil nil)
             (list (make-instance 'exit :x 1 :y 2 :z 0)
                   (make-instance 'vacuum :x 3 :y 2 :z -1)
                   ;; (make-instance 'vacuum :x 3 :y 2 :z -1)
                   (make-instance 'player :x 5 :y 2 :z 0))))
    (10 (list (list nil nil nil nil :west nil nil nil nil :west nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil :west)
              (list (make-instance 'exit        :x 1 :y 3 :z 0)
                    (make-instance 'block-timer :x 4 :y 3 :z 0)
                    ;; (make-instance 'block-timer :x 4 :y 3 :z 0)
                    (make-instance 'player      :x 8 :y 3 :z 0))))
    (11 (list (list nil nil nil nil :west nil nil nil :east nil nil nil :west nil nil nil :east nil nil nil :west)
              (list (make-instance 'exit          :x 1 :y 3 :z 0)


@@ 76,11 76,11 @@
                    (make-instance 'pass-counter :x 4 :y 3 :z 1 :count 3)
                    (make-instance 'player       :x 5 :y 3 :z 0)
                    (make-instance 'wall         :x 8 :y 3 :z 0))))
    (13 (list (list nil nil nil nil :west nil nil nil nil :east nil nil nil nil nil :west nil nil nil nil nil nil nil nil nil :east nil nil nil nil nil nil :west nil nil nil :south)
    (13 (list (list nil nil nil nil :west)
              (list (make-instance 'wall         :x 1 :y 3 :z 0)
                    (make-instance 'exit         :x 5 :y 5 :z 0)
                    (make-instance 'pass-timer   :x 4 :y 3 :z 1 :time 10)
                    (make-instance 'player       :x 6 :y 3 :z 0)
                    ;; (make-instance 'pass-timer   :x 4 :y 3 :z 1 :time 10)
                    (make-instance 'player       :x 6 :y 5 :z 0)
                    (make-instance 'wall         :x 8 :y 3 :z 0))))
    (14 (list (list nil nil nil nil :west nil nil nil nil nil nil nil nil :south)
              (list (make-instance 'wall         :x 1 :y 3 :z 0)


@@ 144,5 144,62 @@
                    (make-instance 'wall         :x 3  :y 8 :z 0)
                    (make-instance 'slope-en     :x 6  :y 8 :z 0)
                    (make-instance 'slope-wn     :x 11 :y 8 :z 0)
                    (make-instance 'wall         :x 5  :y 9 :z 0))))))
                    (make-instance 'wall         :x 5  :y 9 :z 0))))
    (18 (list (list nil nil
                    :west nil nil nil nil nil nil
                    :south nil nil nil nil
                    :east nil nil nil nil
                    :north nil nil nil
                    :south nil nil nil
                    :east nil nil nil nil nil
                    :north nil nil nil
                    :west nil nil
                    :east nil nil nil nil
                    :north nil nil nil nil nil
                    :west nil nil nil nil
                    :south nil nil nil
                    :north nil nil nil nil
                    :west nil nil nil nil nil nil
                    :south nil nil nil
                    :east nil nil
                    :west nil nil nil nil
                    :south)
              (list (make-instance 'wall          :x 5  :y 0 :z 0)
                    (make-instance 'block-counter :x 7  :y 0 :count 1)
                    (make-instance 'block-counter :x 1  :y 1 :count 1)
                    (make-instance 'block-counter :x 9  :y 1 :count 1)
                    (make-instance 'wall          :x 4  :y 2)
                    (make-instance 'wall          :x 6  :y 2)
                    (make-instance 'block-counter :x 0  :y 3 :count 1)
                    (make-instance 'key           :x 3  :y 3)
                    (make-instance 'wall          :x 4  :y 3)
                    (make-instance 'wall          :x 6  :y 3)
                    (make-instance 'key           :x 7  :y 3)
                    (make-instance 'wall          :x 2  :y 4)
                    (make-instance 'wall          :x 3  :y 4)
                    (make-instance 'wall          :x 4  :y 4)
                    (make-instance 'wall          :x 6  :y 4)
                    (make-instance 'wall          :x 7  :y 4)
                    (make-instance 'wall          :x 8  :y 4)
                    (make-instance 'wall          :x 0  :y 5)
                    (make-instance 'player        :x 5  :y 5)
                    (make-instance 'wall          :x 10 :y 5)
                    (make-instance 'wall          :x 2  :y 6)
                    (make-instance 'wall          :x 3  :y 6)
                    (make-instance 'wall          :x 4  :y 6)
                    (make-instance 'wall          :x 6  :y 6)
                    (make-instance 'wall          :x 7  :y 6)
                    (make-instance 'wall          :x 8  :y 6)
                    (make-instance 'key           :x 3  :y 7)
                    (make-instance 'wall          :x 4  :y 7)
                    (make-instance 'wall          :x 6  :y 7)
                    (make-instance 'key           :x 7  :y 7)
                    (make-instance 'block-counter :x 10 :y 7 :count 1)
                    (make-instance 'wall          :x 4  :y 8)
                    (make-instance 'wall          :x 6  :y 8)
                    (make-instance 'block-counter :x 1  :y 9 :count 1)
                    (make-instance 'block-counter :x 9  :y 9 :count 1)
                    (make-instance 'exit          :x 1  :y 10)
                    (make-instance 'block-counter :x 3  :y 10 :count 1)
                    (make-instance 'wall          :x 5  :y 10))))))


M src/main.lisp => src/main.lisp +25 -11
@@ 21,18 21,26 @@
(defparameter *errors* nil)
(defparameter *update-counter* 0)
(defparameter *input* nil)
(defparameter *level-number* 16)
(defparameter *level-number* 0)
(defparameter *running* t)
(defparameter *level* nil)
(defparameter *created* nil)
(defparameter *next-level* 17)
(defparameter *next-level* nil)
(defparameter *level-width* 18)
(defparameter *level-height* 12)
(defparameter *frame-duration* 0.25)
(defparameter *test-run* nil)

(defun verbose-parser (x)
  (setf *verbose* (parse-integer x)))

(defun test-parser (x)
  (setf *test-run* t)
  (let ((num (parse-integer x)))
    (setf *level-number* num)
    (setf *next-level* nil)
    (setf *frame-duration* 0)))

(defun get-current-level()
  (unless *level*
    (load-next-level))


@@ 57,6 65,10 @@
  (:name :version
   :description "Show version information"
   :long "version")
  (:name :test
   :description "Do a test run starting from the given level"
   :long "test"
   :arg-parser #'test-parser)
  (:name :fullscreen
   :description "Run in fullscreen mode"
   :long "fullscreen"))


@@ 107,15 119,17 @@
             do (case ,option ,@clauses)))))

(defun load-next-level ()
  (let ((level-number (mod *next-level* *num-levels*)))
    (setf *next-level* nil)
    (setf *fake-input* nil)
    (setf *level-number* level-number)
    (format t "LEVEL ~A~%" *level-number*)
    (setf *level* nil)
    (let ((loaded (load-level *level-number*)))
      (setf *level* (cadr loaded))
      (setf *fake-input* (car loaded)))))
  (if (and *test-run* (>= *next-level* *num-levels*))
      (running nil)
      (let ((level-number (mod *next-level* *num-levels*)))
        (setf *next-level* nil)
        (setf *fake-input* nil)
        (setf *level-number* level-number)
        (format t "LEVEL ~A~%" *level-number*)
        (setf *level* nil)
        (let ((loaded (load-level *level-number*)))
          (setf *level* (cadr loaded))
          (setf *fake-input* (car loaded))))))

(defun request-next-level ()
  (setf *next-level* (+ *level-number* 1)))

M src/textual.lisp => src/textual.lisp +6 -4
@@ 154,10 154,12 @@
(defparameter *last-fake-input* nil)

(defun ui-input ()
  (let ((input (car *fake-input*)))
    (setf *fake-input* (cdr *fake-input*))
    (setf *last-fake-input* input)
    input))
  (if *test-run*
      (let ((input (car *fake-input*)))
        (setf *fake-input* (cdr *fake-input*))
        (setf *last-fake-input* input)
        input)
      nil))

(defun x-axis (length)
  (let ((result ""))