~octaspire/crates2

bbe925b21b8c279bc43c1b045dbcf45f0bd8f555 — octaspire 10 months ago 48af8d4
Add block counter, remove lamented slot and escape method
M crates2.asd => crates2.asd +1 -0
@@ 28,6 28,7 @@
                 (:file "slopes")
                 (:file "turnstiles")
                 (:file "block-timer")
                 (:file "block-counter")
                 (:file "vacuum")
                 (:file "level")
                 (:file "textual")

M doc/TODO.org => doc/TODO.org +1 -3
@@ 1,3 1,1 @@
- Remove the lamented slot from the crate class and use only the
  lamented state to represent removed crates. Now information is
  stored in two places.
Empty.

A src/block-counter.lisp => src/block-counter.lisp +33 -0
@@ 0,0 1,33 @@
;; Octaspire Crates 2 - Puzzle Game
;; Copyright 2020 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 touches-left ((self block-counter))
  (- (block-counter-count self)
     (block-counter-touches self)))

(defmethod visual ((self block-counter))
  (let ((str (format nil "~2,'0d" (touches-left self))))
    (format nil "BC||~A" str)))

(defmethod collide ((self block-counter) (target moving))
  (ecase (crate-state self)
    (:idle (incf (block-counter-touches self))
     (when (<= (touches-left self) 0)
       (lament self)))
    (:lamented nil)))


M src/block-timer.lisp => src/block-timer.lisp +4 -8
@@ 17,7 17,7 @@
;; Methods

(defmethod update ((self block-timer))
  (ecase (block-timer-state self)
  (ecase (crate-state self)
    (:idle nil)
    (:active
     (incf (block-timer-uptime self) 0.5)


@@ 30,19 30,15 @@
  (ceiling (- (block-timer-time self)
              (block-timer-uptime self))))

(defmethod lament ((self block-timer))
  (setf (block-timer-state self) :lamented)
  (setf (lamented self) t))

(defmethod visual ((self block-timer))
  (let ((durstr (if (block-timer-durable self) "D" "|"))
        (statstr (if (eq (block-timer-state self) :idle) "|" "X"))
        (statstr (if (eq (crate-state self) :idle) "|" "X"))
        (timestr (format nil "~2,'0d" (time-left self))))
    (format nil "BT~A~A~A" durstr statstr timestr)))

(defmethod collide ((self block-timer) (target moving))
  (ecase (block-timer-state self)
    (:idle (setf (block-timer-state self) :active))
  (ecase (crate-state self)
    (:idle (setf (crate-state self) :active))
    (:active (unless (block-timer-durable self)
               (lament self)))
    (:lamented nil)))

M src/classes.lisp => src/classes.lisp +26 -10
@@ 26,9 26,6 @@
   (z :initarg :z
      :initform 0
      :accessor crate-z)
   (lamented :initarg lamented
             :initform nil
             :accessor lamented)
   (visible :initarg :visible
            :accessor crate-visible)
   (state :initarg :state


@@ 86,10 83,7 @@
  ())

(defclass block-timer (crate)
  ((state :initarg :state
          :initform :idle
          :accessor block-timer-state)
   (time :initarg :time
  ((time :initarg :time
         :accessor block-timer-time
         :initform 10)
   (uptime :initarg :time


@@ 97,7 91,15 @@
           :initform 0)
   (durable :initarg :durable
           :accessor block-timer-durable
           :initform t)))
            :initform t)))

(defclass block-counter (crate)
  ((count :initarg :count
          :accessor block-counter-count
          :initform 10)
   (touches :initarg :touches
            :accessor block-counter-touches
            :initform 0)))

(defclass exit (crate)
  ((activated :initarg :activated


@@ 119,7 121,21 @@
;; Generic functions

(defgeneric time-left (self)
  (:documentation "Calculate time left in crate SELF") )
  (:documentation "Calculate time left in crate SELF"))

(defgeneric touches-left (self)
  (:documentation "Calculate number of touches left in crate SELF"))

(defgeneric lament (self)
  (:documentation "Make crate SELF lamented") )
  (:documentation "Make crate SELF lamented"))

(defgeneric lamentedp (self)
  (:documentation "Tell whether crate SELF lamented or not"))

;; Methods

(defmethod lament ((self crate))
  (setf (crate-state self) :lamented))

(defmethod lamentedp ((self crate))
  (eq (crate-state self) :lamented))

M src/level.lisp => src/level.lisp +1 -1
@@ 35,4 35,4 @@
  (setf *level* (remove-if #'(lambda (crate)
                               (let ((type (type-of crate)))
                                 (unless (eq type 'player)
                                   (lamented crate)))) *level*)))
                                   (lamentedp crate)))) *level*)))

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

(defparameter *num-levels* 11)
(defparameter *num-levels* 12)

(defun load-level (index)
  (ecase index


@@ 64,5 64,10 @@
    (10 (list (list nil nil nil nil :west nil nil nil nil :west nil nil nil nil)
              (list (make-instance 'exit        :x 1 :y 3 :z 0)
                    (make-instance 'block-timer :x 4 :y 3 :z 0)
                    (make-instance 'player      :x 8 :y 3 :z 0))))))
                    (make-instance 'player      :x 8 :y 3 :z 0))))
    (11 (list (list nil nil nil nil :west nil nil nil :east nil nil nil :west nil nil nil :east nil nil nil :west)
              (list (make-instance 'exit          :x 1 :y 3 :z 0)
                    (make-instance 'block-counter :x 3 :y 3 :z 0 :count 2)
                    (make-instance 'player        :x 5 :y 3 :z 0)
                    (make-instance 'block-counter :x 8 :y 3 :z 0))))))


M src/moving.lisp => src/moving.lisp +4 -13
@@ 25,9 25,6 @@
(defgeneric stationaryp (self)
  (:documentation "Predicate telling whether moving SELF is not moving"))

(defgeneric escape (self)
  (:documentation "Handle crate SELF flying out of the level"))

;; Methods

(defmethod movingp ((self moving))


@@ 51,7 48,7 @@
  (let* ((x (- (crate-x self) 1))
         (crate (find-at x (crate-y self) (crate-z self))))
    (if (< x 0)
        (escape self)
        (lament self)
        (if crate
            (handle-collision self crate)
            (setf (crate-x self) x)))))


@@ 60,7 57,7 @@
  (let* ((x (+ (crate-x self) 1))
         (crate (find-at x (crate-y self) (crate-z self))))
    (if (>= x *level-width*)
        (escape self)
        (lament self)
        (if crate
            (handle-collision self crate)
            (setf (crate-x self) x)))))


@@ 69,7 66,7 @@
  (let* ((y (- (crate-y self) 1))
         (crate (find-at (crate-x self) y (crate-z self))))
    (if (< y 0)
        (escape self)
        (lament self)
        (if crate
            (handle-collision self crate)
            (setf (crate-y self) y)))))


@@ 78,17 75,11 @@
  (let* ((y (+ (crate-y self) 1))
         (crate (find-at (crate-x self) y (crate-z self))))
    (if (>= y *level-height*)
        (escape self)
        (lament self)
        (if crate
            (handle-collision self crate)
            (setf  (crate-y self) y)))))

(defmethod escape ((self moving))
  (setf (active self) nil)
  (setf (lamented self) t)
  (when (typep self 'player)
    (request-restart-level)))

(defmethod collide ((self moving) (target crate))
  (setf (velocity self) :zero))


M src/player.lisp => src/player.lisp +1 -3
@@ 34,9 34,7 @@
  (setf (active self) nil))

(defmethod collide ((self player) (target vacuum))
  (setf (active self) nil)
  (setf (crate-state self) :lamented)
  (setf (lamented self) t)
  (lament self)
  (call-next-method))

(defmethod handle-input ((self player) input)