~octaspire/crates2

259e997e5748cc7a554326e188e20e018656c345 — octaspire 2 months ago 6774dd1
Implement initial ncurses (cl-charms) renderer
14 files changed, 409 insertions(+), 40 deletions(-)

M .gitignore
M Makefile
M README.org
A crates2-charms.asd
R crates2.asd => crates2-text.asd
M doc/TODO.org
M etc/autoplay.sh
M etc/install.sh
M etc/run.sh
M etc/slime.sh
M etc/test.sh
A src/charms.lisp
M src/main.lisp
M src/textual.lisp
M .gitignore => .gitignore +2 -1
@@ 1,4 1,5 @@
crates2
crates2-text
crates2-charms
.#*
expected.txt.bz2
expected.txt

M Makefile => Makefile +26 -16
@@ 16,30 16,38 @@ LISP    ?= sbcl
EVAL    ?= "--eval"
level   ?= 0

all: crates2-text crates2-charms

.PHONY: slime clean help test

crates2: Makefile crates2.asd src/*.lisp
crates2-text: Makefile crates2-text.asd src/*.lisp etc/*.*
	@$(LISP) $(EVAL) "(progn (declaim (optimize (speed 0) (space 0) (safety 3) (debug 3))) \
                                 (ql:quickload :crates2-text)                                  \
                                 (asdf:make :crates2-text)                                     \
                                 (quit))"

crates2-charms: Makefile crates2-charms.asd src/*.lisp etc/*.*
	@$(LISP) $(EVAL) "(progn (declaim (optimize (speed 0) (space 0) (safety 3) (debug 3))) \
                                 (ql:quickload :crates2)                                       \
                                 (asdf:make :crates2)                                          \
                                 (ql:quickload :crates2-charms)                                \
                                 (asdf:make :crates2-charms)                                   \
                                 (quit))"

slime:
	@etc/slime.sh &

run: crates2
run: crates2-text crates2-charms
	@etc/run.sh

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

install: crates2
install: crates2-text crates2-charms
	@etc/install.sh

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

test: crates2
test: crates2-text
	@etc/test.sh

help:


@@ 47,11 55,13 @@ help:
	@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 '  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'
	@echo '  help     show this help'
	@echo '  all             build standalone binaries crates2 text, charms, SDL and OpenGL (default target)'
	@echo '  crates2-text    build standalone binary executable for crates2 text mode'
	@echo '  crates2-charms  build standalone binary executable for crates2 charms (ncurses) mode'
	@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'
	@echo '  help            show this help'

M README.org => README.org +3 -2
@@ 49,10 49,11 @@ To use crates2 in OpenBSD without Common Lisp REPL - i.e. by running the generat
=crates2= executable directly - the =crates2= executable must be first
copied into ~/usr/local/bin~. This is because of the ~W^X~ protection
that OpenBSD uses. Command ~make run~ does this automagically in =OpenBSD=,
if file ~/etc/doas.conf~ has a line:
if file ~/etc/doas.conf~ has lines:

#+begin_src shell
permit nopass USERNAME as root cmd /bin/cp args crates2 /usr/local/bin/
permit nopass USERNAME as root cmd /bin/cp args crates2-text /usr/local/bin/
permit nopass USERNAME as root cmd /bin/cp args crates2-charms /usr/local/bin/
#+end_src

where ~USERNAME~ is your username. If you are getting error message

A crates2-charms.asd => crates2-charms.asd +46 -0
@@ 0,0 1,46 @@
;; 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.
(asdf:defsystem "crates2-charms"
  :depends-on (:alexandria :unix-opts :parse-float :trivial-garbage :cl-charms)
  :serial t
  :components ((:module src
                :components
                ((:file "package")
                 (:file "classes")
                 (:file "utils")
                 (:file "crate")
                 (:file "moving")
                 (:file "simple-crates")
                 (:file "exit")
                 (:file "key")
                 (:file "pulled")
                 (:file "toggle")
                 (:file "player")
                 (:file "slopes")
                 (:file "turnstiles")
                 (:file "bomb")
                 (:file "block-timer")
                 (:file "block-counter")
                 (:file "pass-counter")
                 (:file "pass-timer")
                 (:file "vacuum")
                 (:file "stepper")
                 (:file "level")
                 (:file "charms")
                 (:file "levels")
                 (:file "main"))))
  :build-operation program-op
  :build-pathname "crates2-charms"
  :entry-point "crates2:main")

R crates2.asd => crates2-text.asd +3 -3
@@ 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.


@@ 12,7 12,7 @@
;; 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.
(asdf:defsystem "crates2"
(asdf:defsystem "crates2-text"
  :depends-on (:alexandria :unix-opts :parse-float :trivial-garbage)
  :serial t
  :components ((:module src


@@ 42,5 42,5 @@
                 (:file "levels")
                 (:file "main"))))
  :build-operation program-op
  :build-pathname "crates2"
  :build-pathname "crates2-text"
  :entry-point "crates2:main")

M doc/TODO.org => doc/TODO.org +1 -1
@@ 1,1 1,1 @@
Empty.
- Move common parts from =charms= and =text= renderers into separate file.

M etc/autoplay.sh => etc/autoplay.sh +4 -4
@@ 20,14 20,14 @@ 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 "permit nopass ${USER} as root cmd /bin/cp args crates2-text /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
    doas /bin/cp crates2-text /usr/local/bin/
    /usr/local/bin/crates2-text --autoplay $1
else
    ./crates2 --autoplay $1
    ./crates2-text --autoplay $1
fi

M etc/install.sh => etc/install.sh +6 -3
@@ 20,12 20,15 @@ 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 "permit nopass ${USER} as root cmd /bin/cp args crates2-text /usr/local/bin/"
    echo "permit nopass ${USER} as root cmd /bin/cp args crates2-charms /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/
    doas /bin/cp crates2-text /usr/local/bin/
    doas /bin/cp crates2-charms /usr/local/bin/
else
    cp crates2 /usr/local/bin/
    cp crates2-text /usr/local/bin/
    cp crates2-charms /usr/local/bin/
fi

M etc/run.sh => etc/run.sh +5 -4
@@ 20,14 20,15 @@ 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 "permit nopass ${USER} as root cmd /bin/cp args crates2-text /usr/local/bin/"
    echo "permit nopass ${USER} as root cmd /bin/cp args crates2-charms /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
    doas /bin/cp crates2-text /usr/local/bin/
    /usr/local/bin/crates2-text
else
    ./crates2
    ./crates2-text
fi

M etc/slime.sh => etc/slime.sh +1 -1
@@ 20,7 20,7 @@ PROGRAM="(progn (slime)                                      \
         (while (not (slime-connected-p)) (sleep-for 0.5))   \
         (slime-repl-eval-string                             \
           \"(progn (declaim (optimize (speed 0) (debug 3))) \
                    (ql:quickload :crates2)                  \
                    (ql:quickload :crates2-text)             \
                    (in-package :crates2))\"))"

if [ -z "${EMACS_SERVER_ON}" ]

M etc/test.sh => etc/test.sh +3 -3
@@ 32,10 32,10 @@ then
    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"
    doas /bin/cp crates2-text /usr/local/bin/
    /usr/local/bin/crates2-text --test 0 > "$GOT_FILE"
else
    ./crates2 --test 0  > "$GOT_FILE"
    ./crates2-text --test 0  > "$GOT_FILE"
fi

if test -e "$EXPECTED_ARCH"

A src/charms.lisp => src/charms.lisp +296 -0
@@ 0,0 1,296 @@
;; 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.
(in-package :crates2)

;; Crate is drawn as CW x CH character shape
(defconstant cw 6)
(defconstant ch 3)

(defparameter *visual-hash* (make-hash-table :test 'equal))

(defun init-visual-hash ()
  ;; VACUUM
  (setf (gethash "vacuum-idle" *visual-hash*) #("+----+" "|suck|" "+----+"))
  (setf (gethash "vacuum-full" *visual-hash*) #("+----+" "|SUCK|" "+----+"))
  ;; WALL
  (setf (gethash "wall-idle" *visual-hash*) #("######" "######" "######"))
  ;; PUSHED
  (setf (gethash "pushed-idle" *visual-hash*) #("+----+" "|PUSH|" "+----+"))
  ;; BLOCK-TIMER
  (setf (gethash "block-timer-durable" *visual-hash*) #("+----+" "BTXX  " "+----+"))
  (setf (gethash "block-timer"         *visual-hash*) #("+----+" "BT    " "+----+"))
  ;; COUNT
  (setf (gethash "count-01"            *visual-hash*) #("      " "    01" "      "))
  (setf (gethash "count-02"            *visual-hash*) #("      " "    02" "      "))
  (setf (gethash "count-03"            *visual-hash*) #("      " "    03" "      "))
  (setf (gethash "count-04"            *visual-hash*) #("      " "    04" "      "))
  (setf (gethash "count-05"            *visual-hash*) #("      " "    05" "      "))
  (setf (gethash "count-06"            *visual-hash*) #("      " "    06" "      "))
  (setf (gethash "count-07"            *visual-hash*) #("      " "    07" "      "))
  (setf (gethash "count-08"            *visual-hash*) #("      " "    08" "      "))
  (setf (gethash "count-09"            *visual-hash*) #("      " "    09" "      "))
  (setf (gethash "count-10"            *visual-hash*) #("      " "    10" "      "))
  (setf (gethash "count-11"            *visual-hash*) #("      " "    11" "      "))
  (setf (gethash "count-12"            *visual-hash*) #("      " "    12" "      "))
  (setf (gethash "count-13"            *visual-hash*) #("      " "    13" "      "))
  (setf (gethash "count-14"            *visual-hash*) #("      " "    14" "      "))
  (setf (gethash "count-15"            *visual-hash*) #("      " "    15" "      "))
  (setf (gethash "count-16"            *visual-hash*) #("      " "    16" "      "))
  (setf (gethash "count-17"            *visual-hash*) #("      " "    17" "      "))
  (setf (gethash "count-18"            *visual-hash*) #("      " "    18" "      "))
  (setf (gethash "count-19"            *visual-hash*) #("      " "    19" "      "))
  (setf (gethash "count-20"            *visual-hash*) #("      " "    20" "      "))
  (setf (gethash "count-21"            *visual-hash*) #("      " "    21" "      "))
  (setf (gethash "count-22"            *visual-hash*) #("      " "    22" "      "))
  (setf (gethash "count-23"            *visual-hash*) #("      " "    23" "      "))
  ;; EXIT
  (setf (gethash "exit-idle" *visual-hash*) #("+----+" "|exit|" "+----+"))
  (setf (gethash "exit-active" *visual-hash*) #("+----+" "|EXIT|" "+----+"))
  ;; KEY
  (setf (gethash "key-idle" *visual-hash*) #("+----+" " KEY  " "+----+"))
  ;; PLAYER
  (setf (gethash "player-active" *visual-hash*) #(" .--. " " |  | " " `--' "))
  (setf (gethash "player-hidden" *visual-hash*) #("      " "      " "      "))
  ;; SLOPES
  (setf (gethash "slope-en" *visual-hash*) #("+--+  " "|   \\ " "+----+"))
  (setf (gethash "slope-es" *visual-hash*) #("+----+" "|   / " "+--+  "))
  (setf (gethash "slope-wn" *visual-hash*) #("  +--+" " /   |" "+----+"))
  (setf (gethash "slope-ws" *visual-hash*) #("+----+" " \\   |" "  +--+"))
  ;; TURNSTILE
  (setf (gethash "turnstile-e1" *visual-hash*) #("+----+" "---->1" "+----+"))
  (setf (gethash "turnstile-w1" *visual-hash*) #("+----+" "1<----" "+----+"))
  (setf (gethash "turnstile-n1" *visual-hash*) #("+1111+" "^^^^^^" "+||||+"))
  (setf (gethash "turnstile-s1" *visual-hash*) #("+||||+" "\\/\\/\\/" "+1111+"))
  (setf (gethash "turnstile-e" *visual-hash*) #("+----+" "----->" "+----+"))
  (setf (gethash "turnstile-w" *visual-hash*) #("+----+" "<-----" "+----+"))
  (setf (gethash "turnstile-n" *visual-hash*) #("+^^^^+" "||||||" "+||||+"))
  (setf (gethash "turnstile-s" *visual-hash*) #("+....+" "||||||" "\\/\\/\\/"))
  ;; BLOCK-COUNTER
  (setf (gethash "block-counter-10" *visual-hash*) #("+----+" "BCXX10" "+----+"))
  (setf (gethash "block-counter-09" *visual-hash*) #("+----+" "BCXX09" "+----+"))
  (setf (gethash "block-counter-08" *visual-hash*) #("+----+" "BCXX08" "+----+"))
  (setf (gethash "block-counter-07" *visual-hash*) #("+----+" "BCXX07" "+----+"))
  (setf (gethash "block-counter-06" *visual-hash*) #("+----+" "BCXX06" "+----+"))
  (setf (gethash "block-counter-05" *visual-hash*) #("+----+" "BCXX05" "+----+"))
  (setf (gethash "block-counter-04" *visual-hash*) #("+----+" "BCXX04" "+----+"))
  (setf (gethash "block-counter-03" *visual-hash*) #("+----+" "BCXX03" "+----+"))
  (setf (gethash "block-counter-02" *visual-hash*) #("+----+" "BCXX02" "+----+"))
  (setf (gethash "block-counter-01" *visual-hash*) #("+----+" "BCXX01" "+----+"))
  (setf (gethash "block-counter-00" *visual-hash*) #("+----+" "BCXX00" "+----+"))
  ;; PASS-COUNTER
  (setf (gethash "pass-counter-10" *visual-hash*) #("+----+" "PC  10" "+----+"))
  (setf (gethash "pass-counter-09" *visual-hash*) #("+----+" "PC  09" "+----+"))
  (setf (gethash "pass-counter-08" *visual-hash*) #("+----+" "PC  08" "+----+"))
  (setf (gethash "pass-counter-07" *visual-hash*) #("+----+" "PC  07" "+----+"))
  (setf (gethash "pass-counter-06" *visual-hash*) #("+----+" "PC  06" "+----+"))
  (setf (gethash "pass-counter-05" *visual-hash*) #("+----+" "PC  05" "+----+"))
  (setf (gethash "pass-counter-04" *visual-hash*) #("+----+" "PC  04" "+----+"))
  (setf (gethash "pass-counter-03" *visual-hash*) #("+----+" "PC  03" "+----+"))
  (setf (gethash "pass-counter-02" *visual-hash*) #("+----+" "PC  02" "+----+"))
  (setf (gethash "pass-counter-01" *visual-hash*) #("+----+" "PC  01" "+----+"))
  (setf (gethash "pass-counter-00" *visual-hash*) #("+----+" "PC  00" "+----+"))
  ;; PASS-TIMER
  (setf (gethash "pass-timer-10" *visual-hash*) #("+----+" "PT  10" "+----+"))
  (setf (gethash "pass-timer-09" *visual-hash*) #("+----+" "PT  09" "+----+"))
  (setf (gethash "pass-timer-08" *visual-hash*) #("+----+" "PT  08" "+----+"))
  (setf (gethash "pass-timer-07" *visual-hash*) #("+----+" "PT  07" "+----+"))
  (setf (gethash "pass-timer-06" *visual-hash*) #("+----+" "PT  06" "+----+"))
  (setf (gethash "pass-timer-05" *visual-hash*) #("+----+" "PT  05" "+----+"))
  (setf (gethash "pass-timer-04" *visual-hash*) #("+----+" "PT  04" "+----+"))
  (setf (gethash "pass-timer-03" *visual-hash*) #("+----+" "PT  03" "+----+"))
  (setf (gethash "pass-timer-02" *visual-hash*) #("+----+" "PT  02" "+----+"))
  (setf (gethash "pass-timer-01" *visual-hash*) #("+----+" "PT  01" "+----+"))
  (setf (gethash "pass-timer-00" *visual-hash*) #("+----+" "PT  00" "+----+"))
  ;; PULLED
  (setf (gethash "pulled-idle"               *visual-hash*) #(".-  -." "|    |" "`-  -'"))
  ;; east
  (setf (gethash "pulled-east-handle-active" *visual-hash*) #("      " "    o " "      "))
  (setf (gethash "pulled-east-handle-idle"   *visual-hash*) #("      " "    = " "      "))
  (setf (gethash "pulled-east-no-handle"     *visual-hash*) #("      " "      " "      "))
  ;; west
  (setf (gethash "pulled-west-handle-active" *visual-hash*) #("      " " o    " "      "))
  (setf (gethash "pulled-west-handle-idle"   *visual-hash*) #("      " " =    " "      "))
  (setf (gethash "pulled-west-no-handle"     *visual-hash*) #("      " "      " "      "))
  ;; north
  (setf (gethash "pulled-north-handle-active" *visual-hash*) #("  oo  " "      " "      "))
  (setf (gethash "pulled-north-handle-idle"   *visual-hash*) #("  ==  " "      " "      "))
  (setf (gethash "pulled-north-no-handle"     *visual-hash*) #("  --  " "      " "      "))
  ;; south
  (setf (gethash "pulled-south-handle-active" *visual-hash*) #("      " "      " "  oo  "))
  (setf (gethash "pulled-south-handle-idle"   *visual-hash*) #("      " "      " "  ==  "))
  (setf (gethash "pulled-south-no-handle"     *visual-hash*) #("      " "      " "  --  "))
  ;; STEPPER
  (setf (gethash "stepper-idle"               *visual-hash*) #("      " "   +  " "      "))
  (setf (gethash "stepper-active"             *visual-hash*) #("      " "   o  " "      "))
  ;; TOGGLE
  (setf (gethash "toggle-idle"                *visual-hash*) #("+-  -+" "|    |" "+-  -+"))
  ;; east
  (setf (gethash "toggle-east-on"             *visual-hash*) #("      " "    o " "      "))
  (setf (gethash "toggle-east-off"            *visual-hash*) #("      " "    | " "      "))
  ;; west
  (setf (gethash "toggle-west-on"             *visual-hash*) #("      " " o    " "      "))
  (setf (gethash "toggle-west-off"            *visual-hash*) #("      " " |    " "      "))
  ;; north
  (setf (gethash "toggle-north-on"            *visual-hash*) #("  oo  " "      " "      "))
  (setf (gethash "toggle-north-off"           *visual-hash*) #("  __  " "      " "      "))
  ;; south
  (setf (gethash "toggle-south-on"            *visual-hash*) #("      " "      " "  oo  "))
  (setf (gethash "toggle-south-off"           *visual-hash*) #("      " "      " "  ''  "))
  ;; BOMB
  (setf (gethash "bomb-durable"  *visual-hash*) #("+----+" "BOMP  " "+----+"))
  (setf (gethash "bomb"          *visual-hash*) #("+----+" "BOMX  " "+----+"))
  ;; ring 1
  ;; ******************
  ;; ******************
  ;; ******************
  ;; ******      ******
  ;; ******      ******
  ;; ******      ******
  ;; ******************
  ;; ******************
  ;; ******************
  (setf (gethash "bomb-ring-1"   *visual-hash*) #("******************" "******************" "******************" "******      ******" "******      ******" "******      ******" "******************" "******************" "******************"))
  ;; ring 2
  ;; ##############################
  ;; ##############################
  ;; ##############################
  ;; ######                  ######
  ;; ######                  ######
  ;; ######                  ######
  ;; ######                  ######
  ;; ######                  ######
  ;; ######                  ######
  ;; ######                  ######
  ;; ######                  ######
  ;; ######                  ######
  ;; ##############################
  ;; ##############################
  ;; ##############################
  (setf (gethash "bomb-ring-2"   *visual-hash*) #("##############################" "##############################" "##############################" "######                  ######" "######                  ######" "######                  ######" "######                  ######" "######                  ######" "######                  ######" "######                  ######" "######                  ######" "######                  ######" "##############################" "##############################" "##############################")))

(defun empty-line ()
  (let* ((w *level-width*)
         (maxi (- w 1))
         (cs (make-array cw :element-type 'character :fill-pointer cw :initial-element #\Space :adjustable nil))
         (s (string "")))
    (loop for i from 0 to maxi
          do (setf s (concatenate 'string s cs)))
    s))

(defun empty-level ()
  (let* ((w (* ch *level-height*))
         (maxi (- w 1))
         (a (make-array w)))
    (loop for i from 0 to maxi
          do (setf (aref a i) (empty-line)))
    a))

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

(defun ui-init ()
  (setf *crates2-window* (cl-charms/low-level:initscr))
  (cl-charms:disable-echoing)
  (cl-charms:enable-raw-input)
  ;; (cl-charms/low-level:raw)
  (cl-charms/low-level:curs-set 0)
  ;; Don't block on getch
  (cl-charms/low-level:timeout 0)
  (cl-charms/low-level:keypad *crates2-window* cl-charms/low-level:TRUE)
  (cl-charms/low-level:keypad cl-charms/low-level:*stdscr* cl-charms/low-level:TRUE))

(defun ui-delete ()
  (cl-charms/low-level:endwin))

(defun ui-read-input ()
  (let ((c (cl-charms/low-level:wgetch *crates2-window*)))
    (case c
      (119 :north)
      (cl-charms/low-level:KEY_UP :north)
      (115 :south)
      (cl-charms/low-level:KEY_DOWN :south)
      (97  :west)
      (cl-charms/low-level:KEY_LEFT :west)
      (100 :east)
      (cl-charms/low-level:KEY_RIGHT :east)
      (113 :back)
      (114 :restart)
      (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 *level*
      (if *test-run*
          (let ((input (car *fake-input*)))
            (setf *fake-input* (cdr *fake-input*))
            (setf *last-input* input)
            input)
          (ui-maybe-read-input))
      nil))

(defun x-axis (length)
  (let ((result ""))
    (loop for i from 0 to (- length 1)
          do (setf result
                   (concatenate 'string result (format nil "~vd" cw i))))
    result))

(defun ui-render (level step)
  (let ((lines (empty-level))
        (x-axis (x-axis *level-width*))
        (bar (format nil "~v@{~A~:*~}" (* cw *level-width*) #\-)))
    (loop for crate in level
          do (progn
               (let* ((x (if (and (= step 0) (typep crate 'moving)) (tail-x crate) (crate-x crate)))
                      (y (if (and (= step 0) (typep crate 'moving)) (tail-y crate) (crate-y crate)))
                      (z (if (and (= step 0) (typep crate 'moving)) (tail-z crate) (crate-z crate)))
                      (vids (visual crate)))
                 (loop for vid in vids
                       do
                          (let ((viv (gethash vid *visual-hash*)))
                            (when viv
                              (let* ((vivh (length viv))
                                     (dy (truncate (/ (- ch vivh) 2))))
                                (loop for liney from 0 to (- vivh 1)
                                      do (let* ((str (aref viv liney))
                                                (vivw (length str))
                                                (dx (truncate (/ (- cw vivw) 2)))
                                                (finy (truncate (+ (* y ch) dy liney))))
                                           (when (>= finy 0)
                                             (let* ((line (aref lines finy))
                                                    (finx (* x cw))
                                                    (deltax (truncate (+ finx dx))))
                                               (setf line (replace-substr-at-transparent-whitespace line deltax str)))))))))))))
    (cl-charms/low-level:clear)
    (cl-charms/low-level:mvaddstr 0 0 x-axis)
    (cl-charms/low-level:mvaddstr 1 0 (format nil "  +~A+ Level ~A~%" bar *level-number*))
    (loop for line across lines
          for y from 0
          do (if (= (mod y ch) 0)
                 (cl-charms/low-level:mvaddstr (+ 2 y) 0 (format nil "~2d|~A|" (floor y ch) line))
                 (cl-charms/low-level:mvaddstr (+ 2 y) 0 (format nil "  |~A|" line)))
             (if (= y 0)
                 (cl-charms/low-level:mvaddstr (+ 3 y) 0 (format nil " Input: ~@[~A~]" *last-input*))
                 (when (= y 1)
                   (cl-charms/low-level:mvaddstr (+ 3 y) 0 (format nil " #updates: ~A~%" *update-counter*))))
          finally (cl-charms/low-level:mvaddstr (+ 3 y) 0 (format nil "  +~A+" bar)))
    (cl-charms/low-level:refresh))
  (setf *last-input* nil))

M src/main.lisp => src/main.lisp +5 -2
@@ 44,7 44,8 @@
  (setf *test-run* t)
  (let ((num (parse-integer x)))
    (setf *level-number* num)
    (setf *next-level* nil)))
    (setf *next-level* nil)
    (setf *frame-duration* 0.05)))

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


@@ 94,6 95,7 @@ This is similar to 'test' but runs much slower."

(defun run (options)
  (unless *errors*
    (ui-init)
    (init-visual-hash)
    (request-next-level)
    (let ((str (make-array 2048 :element-type 'character :fill-pointer 0 :adjustable t))


@@ 128,7 130,8 @@ This is similar to 'test' but runs much slower."
          (format t "~%CRATES2: WARNING EXECUTION STOPPED ON TOO LARGE UPDATE COUNT~%"))
        (setf str (nstring-downcase str))
        (when log-input
          (format t "~%~A~%" str))))))
          (format t "~%~A~%" str))))
    (ui-delete)))

(defun usage ()
  (opts:describe

M src/textual.lisp => src/textual.lisp +8 -0
@@ 201,6 201,14 @@

(defparameter *last-input* nil)

(defun ui-init ()
  ;; Nothing to do.
  )

(defun ui-delete ()
  ;; Nothing to do.
  )

(defun ui-read-input ()
  (format t "Input: ")
  (finish-output)