~octaspire/crates2

ee57a2c1b0784fac1c080f5e6fef5344204418a0 — octaspire 4 months ago 92e6d6b
Add autoplay, level and :back input, fix timers in test mode
M Makefile => Makefile +9 -0
@@ 15,6 15,7 @@
LISP  ?= sbcl
EVAL  ?= "--eval"
LOAD  ?= "--load
level ?= 0

.PHONY: slime clean help test



@@ 29,6 30,12 @@ slime:
run: crates2
	@etc/run.sh

play: crates2
	@etc/autoplay.sh $(level)

install: crates2
	@etc/install.sh

clean:
	@rm -f crates2 expected.txt.bz2 expected.txt got.txt



@@ 42,6 49,8 @@ help:
	@echo 'Targets:'
	@echo '  crates2  build standalone binary executable for crates2 (default target)'
	@echo '  run      build standalone binary and run it'
	@echo '  play     build standalone binary and autoplay it from given level'
	@echo '  install  build standalone binary and install it'
	@echo '  slime    start Emacs/slime (if needed) with crates2 loaded'
	@echo '  clean    remove build artifacts'
	@echo '  test     build and do a play test'

A etc/autoplay.sh => etc/autoplay.sh +33 -0
@@ 0,0 1,33 @@
#!/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)

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 --autoplay $1
else
    ./crates2 --autoplay $1
fi

A etc/install.sh => etc/install.sh +31 -0
@@ 0,0 1,31 @@
#!/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)

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."
    echo "===================================================================================="
    doas /bin/cp crates2 /usr/local/bin/
else
    cp crates2 /usr/local/bin/
fi

M src/block-timer.lisp => src/block-timer.lisp +1 -1
@@ 20,7 20,7 @@
  (ecase (crate-state self)
    (:idle nil)
    (:active
     (incf (block-timer-uptime self) *frame-duration*)
     (incf (block-timer-uptime self) *frame-duration-default*)
     (when (<= (time-left self) 0)
       (lament self)))
    (:lamented nil))

M src/level.lisp => src/level.lisp +4 -0
@@ 36,6 36,10 @@
  (find-if #'(lambda (crate)
               (eq (type-of crate) 'key)) *level*))

(defun find-first-crate-of-type (type)
  (find-if #'(lambda (crate)
               (eq (type-of crate) type)) *level*))

(defun purge-lamented ()
  (setf *level* (remove-if #'(lambda (crate)
                               (let ((type (type-of crate)))

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

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

(defun load-level (index)
  (ecase index


@@ 114,37 114,94 @@
                    (make-instance 'pulled       :x 8 :y 9 :z 0 :north t)
                    (make-instance 'exit         :x 8 :y 2 :z 0))))
    (17 (list (list nil nil
                    :north 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 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
                    :west nil nil nil nil nil nil nil nil nil nil nil
                    :south nil nil nil nil nil nil
                    :north nil nil nil nil nil nil
                    :east nil nil nil nil nil nil nil nil nil nil
                    :south nil nil nil
                    :west nil nil nil nil nil
                    :east nil nil nil nil nil nil
                    :north nil nil nil nil nil nil nil nil
                    :east nil nil nil
                    :north nil nil
                    :west nil nil
                    :south nil nil nil nil
                    :west nil nil nil nil
                    :north nil nil nil
                    :north nil nil nil nil nil
                    :east nil nil nil
                    :north nil nil
                    :east nil nil nil nil nil nil
                    :south nil nil nil
                    :west nil nil nil nil
                    :south nil nil nil nil nil
                    :west nil nil nil nil
                    :south nil nil nil
                    :west nil nil nil nil
                    :south nil nil
                    :west nil nil nil
                    :north nil nil nil
                    :west)
              (list (make-instance 'slope-es     :x 6  :y 0 :z 0)
                    (make-instance 'slope-ws     :x 11 :y 0 :z 0)
                    (make-instance 'block-timer  :x 2  :y 2 :z 0 :time 18)
                    (make-instance 'exit         :x 0  :y 3 :z 0 )
                    (make-instance 'turnstile-s  :x 3  :y 3 :z 0 )
                    (make-instance 'player       :x 6  :y 3 :z 0 )
                    (make-instance 'pass-counter :x 11 :y 3 :z 1 :count 2)
                    (make-instance 'wall         :x 9  :y 4 :z 0)
                    (make-instance 'wall         :x 4  :y 5 :z 0)
                    (make-instance 'wall         :x 1  :y 6 :z 0)
                    (make-instance 'wall         :x 8  :y 6 :z 0)
                    (make-instance 'key          :x 3  :y 7 :z 0)
                    (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))))
                    :west nil nil
                    :north nil nil
                    :west nil nil
                    :north nil nil nil nil nil nil nil
                    :east nil nil nil nil
                    :south nil nil nil
                    :east nil nil
                    :south nil nil nil nil nil
                    :north nil nil nil nil
                    :east nil nil nil nil
                    :north nil nil
                    :west nil nil nil
                    :north nil nil nil nil nil nil
                    :south nil nil nil nil nil nil nil
                    :west nil nil
                    :north nil nil nil nil
                    :west nil nil nil nil nil ; this takes us out from the heart to (0,5)
                    :east nil
                    :south nil nil
                    :east nil nil
                    :south nil nil nil
                    :east nil nil nil nil nil
                    :north nil nil
                    :east nil nil
                    :north nil nil
                    :east nil nil nil nil nil
                    :east)
              (list (make-instance 'wall        :x 1  :y 0 :z 0)
                    (make-instance 'wall        :x 6  :y 1 :z 0)
                    (make-instance 'key         :x 7  :y 1 :z 0)
                    (make-instance 'slope-ws    :x 10 :y 1 :z 0)
                    (make-instance 'wall        :x 13 :y 2 :z 0)
                    (make-instance 'wall        :x 3  :y 3 :z 0)
                    (make-instance 'wall        :x 4  :y 3 :z 0)
                    (make-instance 'wall        :x 8  :y 3 :z 0)
                    (make-instance 'wall        :x 9  :y 3 :z 0)
                    (make-instance 'wall        :x 2  :y 4 :z 0)
                    (make-instance 'key         :x 4  :y 4 :z 0)
                    (make-instance 'turnstile-e :x 5  :y 4 :z 0)
                    (make-instance 'turnstile-s :x 7  :y 4 :z 0)
                    (make-instance 'key         :x 8  :y 4 :z 0)
                    (make-instance 'wall        :x 10 :y 4 :z 0)
                    (make-instance 'slope-es    :x 0  :y 5 :z 0)
                    (make-instance 'turnstile-w :x 2  :y 5 :z 0)
                    (make-instance 'wall        :x 6  :y 5 :z 0)
                    (make-instance 'turnstile-e :x 10 :y 5 :z 0)
                    (make-instance 'turnstile-e :x 12 :y 5 :z 0)
                    (make-instance 'block-timer :x 14 :y 5 :z 0 :time 18)
                    (make-instance 'wall        :x 2  :y 6 :z 0)
                    (make-instance 'wall        :x 10 :y 6 :z 0)
                    (make-instance 'exit        :x 16 :y 6 :z 0)
                    (make-instance 'wall        :x 2  :y 7 :z 0)
                    (make-instance 'wall        :x 10 :y 7 :z 0)
                    (make-instance 'wall        :x 0  :y 8 :z 0)
                    (make-instance 'wall        :x 3  :y 8 :z 0)
                    (make-instance 'wall        :x 9  :y 8 :z 0)
                    (make-instance 'slope-wn    :x 14 :y 8 :z 0)
                    (make-instance 'wall        :x 4  :y 9 :z 0)
                    (make-instance 'wall        :x 8  :y 9 :z 0)
                    (make-instance 'wall        :x 1  :y 10 :z 0)
                    (make-instance 'wall        :x 5  :y 10 :z 0)
                    (make-instance 'wall        :x 7  :y 10 :z 0)
                    (make-instance 'wall        :x 11 :y 10 :z 0)
                    (make-instance 'turnstile-n :x 6  :y 11 :z 0)
                    (make-instance 'wall        :x 9  :y 12 :z 0)
                    (make-instance 'wall        :x 3  :y 13 :z 0)
                    (make-instance 'wall        :x 7  :y 14 :z 0)
                    (make-instance 'player      :x 0  :y 14 :z 0))))
    (18 (list (list nil nil
                    :west nil nil nil nil nil nil
                    :south nil nil nil nil


@@ 201,5 258,40 @@
                    (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))))))
                    (make-instance 'wall          :x 5  :y 10))))
    (19 (list (list nil nil
                    :north 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 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 nil nil nil nil nil nil
                    :west nil nil nil nil nil nil nil nil nil nil
                    :south nil nil nil nil nil
                    :north nil nil nil nil nil
                    :east nil nil nil nil nil
                    :south nil nil nil nil nil
                    :west nil nil nil nil nil
                    :south nil nil nil nil nil
                    :west nil nil nil nil nil
                    :north nil nil nil nil nil
                    :west nil nil nil nil nil
                    :north nil nil nil nil nil
                    :west)
              (list (make-instance 'slope-es      :x 6  :y 0 :z 0)
                    (make-instance 'slope-ws      :x 11 :y 0 :z 0)
                    (make-instance 'block-timer   :x 2  :y 2 :z 0 :time 18)
                    (make-instance 'exit          :x 0  :y 3 :z 0)
                    (make-instance 'turnstile-s   :x 3  :y 3 :z 0)
                    (make-instance 'player        :x 6  :y 3 :z 0)
                    (make-instance 'pass-counter  :x 11 :y 3 :z 1 :count 2)
                    (make-instance 'wall          :x 9  :y 4 :z 0)
                    (make-instance 'wall          :x 4  :y 5 :z 0)
                    (make-instance 'wall          :x 1  :y 6 :z 0)
                    (make-instance 'wall          :x 8  :y 6 :z 0)
                    (make-instance 'key           :x 3  :y 7 :z 0)
                    (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))))))


M src/main.lisp => src/main.lisp +23 -9
@@ 1,5 1,5 @@
;; Octaspire Crates 2 - Puzzle Game
;; Copyright 2020 octaspire.com
;; 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.


@@ 25,21 25,25 @@
(defparameter *running* t)
(defparameter *level* nil)
(defparameter *created* nil)
(defparameter *next-level* nil)
(defparameter *next-level* 19)
(defparameter *level-width* 18)
(defparameter *level-height* 12)
(defparameter *frame-duration* 0.25)
(defparameter *level-height* 15)
(defparameter *frame-duration-default* 0.25) ; Not zeroed in test mode.
(defparameter *frame-duration* *frame-duration-default*) ; Zeroed in test mode.
(defparameter *test-run* nil)

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

(defun test-parser (x)
  (autoplay-parser x)
  (setf *frame-duration* 0))

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

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


@@ 66,9 70,16 @@
   :description "Show version information"
   :long "version")
  (:name :test
   :description "Do a test run starting from the given level"
   :description "Do a test run starting from the given level.
This is similar to 'autoplay' but runs without delays, i.e. too fast
to see what happens."
   :long "test"
   :arg-parser #'test-parser)
  (:name :autoplay
   :description "Do a autoplay run starting from the given level.
This is similar to 'test' but runs much slower."
   :long "autoplay"
   :arg-parser #'autoplay-parser)
  (:name :fullscreen
   :description "Run in fullscreen mode"
   :long "fullscreen"))


@@ 86,7 97,8 @@
             (ui-render *level*)
             (let ((input (ui-input)))
               (when input
                 (setf *input* (cons input *input*))))
                 (setf *input* (cons input *input*))
                 (when (eq input :back) (running nil))))
             (update *level*)
             (when *next-level*
               (load-next-level))


@@ 132,7 144,9 @@
          (setf *fake-input* (car loaded))))))

(defun request-next-level ()
  (setf *next-level* (+ *level-number* 1)))
  ;; Don't override previous request, if present.
  (unless *next-level*
    (setf *next-level* (+ *level-number* 1))))

(defun request-restart-level ()
  (format t "RESTART~%")

M src/pass-timer.lisp => src/pass-timer.lisp +1 -1
@@ 33,7 33,7 @@
       (when crate
         (setf (crate-state self) :countdown))))
    (:countdown
     (incf (pass-timer-uptime self) *frame-duration*)
     (incf (pass-timer-uptime self) *frame-duration-default*)
     (when (<= (time-left self) 0)
       (setf (crate-state self) :triggered)))
    (:triggered

M src/textual.lisp => src/textual.lisp +23 -5
@@ 151,15 151,33 @@

(defparameter *fake-input* nil)

(defparameter *last-fake-input* nil)
(defparameter *last-input* nil)

(defun ui-read-input ()
  (format t "Input: ")
  (finish-output)
  (let ((c (read-char)))
    (case c
      (#\w :north)
      (#\s :south)
      (#\a :west)
      (#\d :east)
      (#\q :back)
      (otherwise nil))))

(defun ui-maybe-read-input ()
  (let ((player (find-first-crate-of-type 'player)))
    (if (and player (movingp player))
        nil                    ; No input while player moves, in textual mode.
        (setf *last-input* (ui-read-input)))))

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

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


@@ 195,9 213,9 @@
                 (format t "~2d|~A|" (floor y ch) line)
                 (format t "  |~A|" line))
             (if (= y 0)
                 (format t " Input: ~@[~A~]~%" *last-fake-input*)
                 (format t " Input: ~@[~A~]~%" *last-input*)
                 (if (= y 1)
                     (format t " #updates: ~A~%" *update-counter*)
                     (format t "~%"))))
    (format t "  +~A+~%" bar))
  (setf *last-fake-input* nil))
  (setf *last-input* nil))