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

@@ 30,6 30,7 @@
                  (:file "player")
                  (:file "slopes")
                  (:file "turnstiles")
+                 (:file "bomb")
                  (:file "block-timer")
                  (:file "block-counter")
                  (:file "pass-counter")

@@ 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)))
+

@@ 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)

@@ 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))))))
 

@@ 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.

@@ 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*)