~octaspire/crates2

6774dd164f61217305404f7982ee3d965faa4962 — octaspire 4 months ago 7bb1e75
Implement initial version of bomb crate
6 files changed, 148 insertions(+), 6 deletions(-)

M crates2.asd
A src/bomb.lisp
M src/classes.lisp
M src/levels.lisp
M src/main.lisp
M src/textual.lisp
M crates2.asd => crates2.asd +1 -0
@@ 30,6 30,7 @@
                 (:file "player")
                 (:file "slopes")
                 (:file "turnstiles")
                 (:file "bomb")
                 (:file "block-timer")
                 (:file "block-counter")
                 (:file "pass-counter")

A src/bomb.lisp => src/bomb.lisp +88 -0
@@ 0,0 1,88 @@
;; 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 purge-ring ((self bomb) ring)
  (let* ((x1 (max (- (crate-x self) ring) 0))
         (y1 (max (- (crate-y self) ring) 0))
         (x2 (min (+ (crate-x self) ring) (- *level-width* 1)))
         (y2 (min (+ (crate-y self) ring) (- *level-height* 1)))
         (z (crate-z self)))
    (loop for y from y1 to y2
          do
             (loop for x from x1 to x2
                   do
                      (let ((crate (find-at x y z)))
                        (when crate
                          (typecase crate
                            (player (lament crate))
                            (bomb (unless (bomb-durable crate)
                                      (activate crate))))))))))

(defmethod activate ((self bomb))
  (when (eq (crate-state self) :idle)
    (setf (crate-state self) :active)))

(defmethod update ((self bomb))
  (ecase (crate-state self)
    (:idle nil)
    (:active
     (incf (bomb-uptime self) *frame-duration-default*)
     (when (<= (time-left self) 0)
       (setf (crate-state self) :explosion1)))
    (:explosion1
     (setf (crate-state self) :explosion2))
    (:explosion2
     (purge-ring self 1)
     (setf (crate-state self) :explosion3))
    (:explosion3
     (setf (crate-state self) :explosion4))
    (:explosion4
     (purge-ring self 2)
     (setf (crate-state self) :exploded))
    (:exploded
     (lament self))
    (:lamented nil))
  (call-next-method))

(defmethod time-left ((self bomb))
  (ceiling (- (bomb-time self)
              (bomb-uptime self))))

(defmethod visual ((self bomb))
  (let ((timestr (format nil "count-~2,'0d" (time-left self))))
    (list (if (bomb-durable self)
              "bomb-durable"
              "bomb")
          (case (crate-state self)
            (:explosion1
             "bomb-ring-1")
            (:explosion2
             "bomb-ring-1")
            (:explosion3
             "bomb-ring-2")
            (:explosion4
             "bomb-ring-2"))
          timestr)))

(defmethod collide ((self bomb) (target moving))
  (case (crate-state self)
    (:idle (setf (crate-state self) :active))
    (:active (unless (bomb-durable self)
               (setf (crate-state self) :explosion1)))
    (:lamented nil)))


M src/classes.lisp => src/classes.lisp +12 -1
@@ 88,6 88,17 @@
(defclass turnstile-s (turnstile-s1)
  ())

(defclass bomb (crate)
  ((time :initarg :time
         :accessor bomb-time
         :initform 10)
   (uptime :initarg :uptime
           :accessor bomb-uptime
           :initform 0)
   (durable :initarg :durable
            :accessor bomb-durable
            :initform nil)))

(defclass block-timer (crate)
  ((time :initarg :time
         :accessor block-timer-time


@@ 96,7 107,7 @@
           :accessor block-timer-uptime
           :initform 0)
   (durable :initarg :durable
           :accessor block-timer-durable
            :accessor block-timer-durable
            :initform t)))

(defclass block-counter (crate)

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

(defparameter *num-levels* 8)
(defparameter *num-levels* 9)

(defun load-level (index)
  (ecase index


@@ 1164,5 1164,16 @@
                   (make-instance 'wall   :x 12   :y 11 :z 0)
                   (make-instance 'wall   :x 13   :y 11 :z 0)
                   (make-instance 'wall   :x 14   :y 11 :z 0)
                   (make-instance 'wall   :x 15   :y 11 :z 0))))))
                   (make-instance 'wall   :x 15   :y 11 :z 0))))
    (8 (list (list nil nil nil nil
                   :west  nil nil nil nil
                   :east 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)
             (list (make-instance 'player       :x 4 :y 3 :z 0)
                   (make-instance 'exit         :x 0 :y 3 :z 0)
                   (make-instance 'wall         :x 8 :y 3 :z 0)
                   (make-instance 'bomb         :x 2 :y 3 :z 0 :time 5)
                   (make-instance 'bomb         :x 4 :y 5 :z 0 :time 2)
                   (make-instance 'bomb         :x 6 :y 6 :z 0 :time 2))))))


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* nil)
(defparameter *next-level* 8)
(defparameter *level-width* 20)
(defparameter *level-height* 20)
(defparameter *frame-duration-default* 0.25) ; Not zeroed in test mode.

M src/textual.lisp => src/textual.lisp +33 -2
@@ 57,7 57,7 @@
  (setf (gethash "count-23"            *visual-hash*) #("      " "    23" "      "))
  ;; EXIT
  (setf (gethash "exit-idle" *visual-hash*) #("+----+" "|exit|" "+----+"))
  (setf (gethash "exit-active" *visual-hash*) #("+----------+" "|          |" "|          |" "|          |" "+----------+"))
  (setf (gethash "exit-active" *visual-hash*) #("+----+" "|EXIT|" "+----+"))
  ;; KEY
  (setf (gethash "key-idle" *visual-hash*) #("+----+" " KEY  " "+----+"))
  ;; PLAYER


@@ 147,7 147,38 @@
  (setf (gethash "toggle-north-off"           *visual-hash*) #("  __  " "      " "      "))
  ;; south
  (setf (gethash "toggle-south-on"            *visual-hash*) #("      " "      " "  oo  "))
  (setf (gethash "toggle-south-off"           *visual-hash*) #("      " "      " "  ''  ")))
  (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*)