~octaspire/crates2

e5297da8d19288570ff875f5c75329ba577ecddf — octaspire 2 months ago 26be0b8
Add stepper and toggle crates, start to add level

  * Add stepper and toggle crates.
  * Start to add level - fake input for it is not finished.
  * Modify textual representation for player and pulled crates.
M README.org => README.org +1 -1
@@ 70,7 70,7 @@ make slime

#+begin_example
   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.

M crates2.asd => crates2.asd +2 -0
@@ 26,6 26,7 @@
                 (:file "exit")
                 (:file "key")
                 (:file "pulled")
                 (:file "toggle")
                 (:file "player")
                 (:file "slopes")
                 (:file "turnstiles")


@@ 34,6 35,7 @@
                 (:file "pass-counter")
                 (:file "pass-timer")
                 (:file "vacuum")
                 (:file "stepper")
                 (:file "level")
                 (:file "textual")
                 (:file "levels")

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

M src/classes.lisp => src/classes.lisp +17 -0
@@ 43,6 43,9 @@
(defclass wall (crate)
  ())

(defclass stepper (crate)
  ())

(defclass slope-en (crate)
  ())



@@ 145,6 148,20 @@
          :accessor pulled-south
          :initform nil)))

(defclass toggle (moving)
  ((east :initarg :east
         :accessor toggle-east
         :initform nil)
   (west :initarg :west
         :accessor toggle-west
         :initform nil)
   (north :initarg :north
          :accessor toggle-north
          :initform nil)
   (south :initarg :south
          :accessor toggle-south
          :initform nil)))

(defclass player (moving)
  ((delay :initform 0
          :accessor player-delay)))

M src/exit.lisp => src/exit.lisp +2 -1
@@ 22,7 22,8 @@
    (:activated
     (if (< (exit-delay self) 3)
         (incf (exit-delay self))
         (if (contains-keys-p)
         (if (or (contains-keys-p)
                 (contains-off-toggles-p))
             (request-restart-level)
             (request-next-level)))))
  (call-next-method))

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

(defun contains-off-toggles-p ()
  (find-if #'(lambda (crate)
               (and (eq (type-of crate) 'toggle)
                    (not (toggle-on-p crate)))) *level*))

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

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

(defparameter *num-levels* 21)
(defparameter *num-levels* 22)

(defun load-level (index)
  (ecase index


@@ 456,5 456,134 @@
                    (make-instance 'wall          :x 15 :y 7 :z 0)
                    (make-instance 'wall          :x 16 :y 7 :z 0)
                    (make-instance 'wall          :x 17 :y 7 :z 0)
                    (make-instance 'wall          :x 18 :y 7 :z 0))))))
                    (make-instance 'wall          :x 18 :y 7 :z 0))))
    (21 (list (list nil nil
                    :north nil nil nil
                    :west :west :west
                    :north nil nil
                    :south nil nil
                    :west
                    :north nil nil
                    :south nil nil
                    :west :west
                    :north :north
                    :east nil nil nil
                    :north
                    :west nil nil nil
                    :north
                    :east nil
                    :west)
              (list (make-instance 'pulled :x 3  :y 3 :z 0 :north t :south t :east t :west t) ; Top line
                    (make-instance 'pulled :x 4  :y 3 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 5  :y 3 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 9  :y 3 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 10 :y 3 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 11 :y 3 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 3  :y 4 :z 0 :north t :south t :east t :west t) ; Second line
                    (make-instance 'toggle :x 4  :y 4 :z 0)
                    (make-instance 'pulled :x 5  :y 4 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 6  :y 4 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 8  :y 4 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 9  :y 4 :z 0 :north t :south t :east t :west t)
                    (make-instance 'toggle :x 10 :y 4 :z 0)
                    (make-instance 'pulled :x 11 :y 4 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 3  :y 5 :z 0 :north t :south t :east t :west t) ; Third line
                    (make-instance 'pulled :x 4  :y 5 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 5  :y 5 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 6  :y 5 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 7  :y 5 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 8  :y 5 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 9  :y 5 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 10 :y 5 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 11 :y 5 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 4  :y 6 :z 0 :north t :south t :east t :west t) ; Fourth line
                    (make-instance 'pulled :x 5  :y 6 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 6  :y 6 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 7  :y 6 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 8  :y 6 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 9  :y 6 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 10 :y 6 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 5  :y 6 :z 0 :north t :south t :east t :west t) ; Fifth line
                    (make-instance 'pulled :x 6  :y 6 :z 0 :north t :south t :east t :west t)
                    (make-instance 'exit   :x 7  :y 6 :z 0)
                    (make-instance 'pulled :x 8  :y 6 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 9  :y 6 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 4  :y 7 :z 0 :north t :south t :east t :west t) ; Mirror fourth line
                    (make-instance 'pulled :x 5  :y 7 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 6  :y 7 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 7  :y 7 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 8  :y 7 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 9  :y 7 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 10 :y 7 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 3  :y 8 :z 0 :north t :south t :east t :west t) ; Mirrored third line
                    (make-instance 'pulled :x 4  :y 8 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 5  :y 8 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 6  :y 8 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 7  :y 8 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 8  :y 8 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 9  :y 8 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 10 :y 8 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 11 :y 8 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 3  :y 9 :z 0 :north t :south t :east t :west t) ; Mirrored second line
                    (make-instance 'toggle :x 4 :y 9 :z 0)
                    (make-instance 'pulled :x 5  :y 9 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 6  :y 9 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 8  :y 9 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 9  :y 9 :z 0 :north t :south t :east t :west t)
                    (make-instance 'toggle :x 10 :y 9 :z 0)
                    (make-instance 'pulled :x 11 :y 9 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 3  :y 10 :z 0 :north t :south t :east t :west t) ; Mirrored top line
                    (make-instance 'pulled :x 4  :y 10 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 5  :y 10 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 9  :y 10 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 10 :y 10 :z 0 :north t :south t :east t :west t)
                    (make-instance 'pulled :x 11 :y 10 :z 0 :north t :south t :east t :west t)
                    (make-instance 'player :x 7  :y 13 :z 0)
                    (make-instance 'stepper :x 1  :y 1 :z -1) ; Top row
                    (make-instance 'stepper :x 2  :y 1 :z -1)
                    (make-instance 'stepper :x 3  :y 1 :z -1)
                    (make-instance 'stepper :x 4  :y 1 :z -1)
                    (make-instance 'stepper :x 5  :y 1 :z -1)
                    (make-instance 'stepper :x 6  :y 1 :z -1)
                    (make-instance 'stepper :x 7  :y 1 :z -1)
                    (make-instance 'stepper :x 8  :y 1 :z -1)
                    (make-instance 'stepper :x 9  :y 1 :z -1)
                    (make-instance 'stepper :x 10 :y 1 :z -1)
                    (make-instance 'stepper :x 11 :y 1 :z -1)
                    (make-instance 'stepper :x 12 :y 1 :z -1)
                    (make-instance 'stepper :x 13 :y 1 :z -1)
                    (make-instance 'stepper :x 1  :y 2 :z -1) ; West column
                    (make-instance 'stepper :x 1  :y 3 :z -1)
                    (make-instance 'stepper :x 1  :y 4 :z -1)
                    (make-instance 'stepper :x 1  :y 5 :z -1)
                    (make-instance 'stepper :x 1  :y 6 :z -1)
                    (make-instance 'stepper :x 1  :y 7 :z -1)
                    (make-instance 'stepper :x 1  :y 8 :z -1)
                    (make-instance 'stepper :x 1  :y 9 :z -1)
                    (make-instance 'stepper :x 1  :y 10 :z -1)
                    (make-instance 'stepper :x 1  :y 11 :z -1)
                    (make-instance 'stepper :x 1  :y 12 :z -1)
                    (make-instance 'stepper :x 1  :y 12 :z -1) ; Bottom row
                    (make-instance 'stepper :x 2  :y 12 :z -1)
                    (make-instance 'stepper :x 3  :y 12 :z -1)
                    (make-instance 'stepper :x 4  :y 12 :z -1)
                    (make-instance 'stepper :x 5  :y 12 :z -1)
                    (make-instance 'stepper :x 6  :y 12 :z -1)
                    (make-instance 'stepper :x 7  :y 12 :z -1)
                    (make-instance 'stepper :x 8  :y 12 :z -1)
                    (make-instance 'stepper :x 9  :y 12 :z -1)
                    (make-instance 'stepper :x 10 :y 12 :z -1)
                    (make-instance 'stepper :x 11 :y 12 :z -1)
                    (make-instance 'stepper :x 12 :y 12 :z -1)
                    (make-instance 'stepper :x 13 :y 12 :z -1)
                    (make-instance 'stepper :x 13 :y 2 :z -1) ; East column
                    (make-instance 'stepper :x 13  :y 3 :z -1)
                    (make-instance 'stepper :x 13  :y 4 :z -1)
                    (make-instance 'stepper :x 13  :y 5 :z -1)
                    (make-instance 'stepper :x 13  :y 6 :z -1)
                    (make-instance 'stepper :x 13  :y 7 :z -1)
                    (make-instance 'stepper :x 13  :y 8 :z -1)
                    (make-instance 'stepper :x 13  :y 9 :z -1)
                    (make-instance 'stepper :x 13  :y 10 :z -1)
                    (make-instance 'stepper :x 13  :y 11 :z -1))))))


M src/main.lisp => src/main.lisp +1 -1
@@ 25,7 25,7 @@
(defparameter *running* t)
(defparameter *level* nil)
(defparameter *created* nil)
(defparameter *next-level* 20)
(defparameter *next-level* 21)
(defparameter *level-width* 20)
(defparameter *level-height* 15)
(defparameter *frame-duration-default* 0.25) ; Not zeroed in test mode.

A src/stepper.lisp => src/stepper.lisp +34 -0
@@ 0,0 1,34 @@
;; 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)

;; Methods

(defmethod update ((self stepper))
  (let ((crate (find-at-of-type (crate-x self) (crate-y self) 0 'moving)))
    (case (crate-state self)
        (:idle
         (when crate
           (setf (crate-state self) :active)
           (setf (velocity crate) :zero)))
        (:active
         (unless crate
           (setf (crate-state self) :idle)))))
  (call-next-method))

(defmethod visual ((self stepper))
  (if (eq (crate-state self) :active)
      (list "stepper-active")
      (list "stepper-idle")))

M src/textual.lisp => src/textual.lisp +31 -14
@@ 61,7 61,7 @@
  ;; KEY
  (setf (gethash "key-idle" *visual-hash*) #("+----+" " KEY  " "+----+"))
  ;; PLAYER
  (setf (gethash "player-active" *visual-hash*) #("+----+" "|oooo|" "+----+"))
  (setf (gethash "player-active" *visual-hash*) #(" .--. " " |  | " " `--' "))
  (setf (gethash "player-hidden" *visual-hash*) #("      " "      " "      "))
  ;; SLOPES
  (setf (gethash "slope-en" *visual-hash*) #("+--+  " "|   \\ " "+----+"))


@@ 114,23 114,40 @@
  (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*) #("-- ---" "      " "-- ---"))
  (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*) #("      " "     |" "      "))
  (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*) #("      " "|     " "      "))
  (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*) #("  o   " "      " "      "))
  (setf (gethash "pulled-north-handle-idle"   *visual-hash*) #("  +   " "      " "      "))
  (setf (gethash "pulled-north-no-handle"     *visual-hash*) #("  -   " "      " "      "))
  (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*) #("      " "      " "  o   "))
  (setf (gethash "pulled-south-handle-idle"   *visual-hash*) #("      " "      " "  +   "))
  (setf (gethash "pulled-south-no-handle"     *visual-hash*) #("      " "      " "  -   ")))
  (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*) #("      " "      " "  ''  ")))

(defun empty-line ()
  (let* ((w *level-width*)

A src/toggle.lisp => src/toggle.lisp +52 -0
@@ 0,0 1,52 @@
;; 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)

;; Methods

(defmethod toggle-on-p ((self toggle))
  (and (toggle-east self)
       (toggle-west self)
       (toggle-north self)
       (toggle-south self)))

(defmethod visual ((self toggle))
  (let ((result (list "toggle-idle")))
    ;; EAST
    (if (toggle-east self)
        (nconc result (list "toggle-east-on"))
        (nconc result (list "toggle-east-off")))
    ;; WEST
    (if (toggle-west self)
        (nconc result (list "toggle-west-on"))
        (nconc result (list "toggle-west-off")))
    ;; NORTH
    (if (toggle-north self)
        (nconc result (list "toggle-north-on"))
        (nconc result (list "toggle-north-off")))
    ;; SOUTH
    (if (toggle-south self)
        (nconc result (list "toggle-south-on"))
        (nconc result (list "toggle-south-off")))
    result))

(defmethod collide ((self toggle) (target moving))
  (let ((side (on-which-side-is-other self target)))
      (ecase side
        (:east (setf (toggle-east self) t))
        (:west (setf (toggle-west self) t))
        (:north (setf (toggle-north self) t))
        (:south (setf (toggle-south self) t))
        (:zero nil))))