~octaspire/crates2

3cb28caecf20d8b3a47957bd761d678528dd4739 — octaspire 10 months ago 90662a0
Continue implementation

 * Add initial vacuum crate
 * Add 'run' target to Makefile
 * Continue implementing
 * Refactor
5 files changed, 115 insertions(+), 59 deletions(-)

M Makefile
M src/crates.lisp
M src/level.lisp
M src/main.lisp
M src/textual.lisp
M Makefile => Makefile +4 -0
@@ 27,6 27,9 @@ crates2: Makefile crates2.asd $(SOURCES)
slime:
	@etc/slime.sh &

run: crates2
	@./crates2

clean:
	@rm -f crates2



@@ 36,6 39,7 @@ help:
	@echo ""
	@echo "Targets:"
	@echo "  crates2  build standalone binary executable for crates2 (default target)"
	@echo "  run      build standalone binary and run it"
	@echo "  slime    start Emacs/slime (if needed) with crates2 loaded"
	@echo "  clean    remove build artifacts"
	@echo "  help     show this help"
\ No newline at end of file

M src/crates.lisp => src/crates.lisp +92 -47
@@ 26,6 26,15 @@
                   nil))
           *level*))

(defun find-at-of-type (x y z type)
  "Get crate of TYPE at (X,Y,Z) or NIL if location is empty or crate is not of TYPE."
  (let ((crate (find-at x y z)))
    (if crate
        (if (subtypep (type-of crate) type)
            crate
            nil)
        nil)))

;; Classes

(defclass crate ()


@@ 34,36 43,48 @@
   (y :initarg :y
      :accessor y)
   (z :initarg :z
      :accessor z)))
      :accessor z)
   (visible :initarg :visible
      :accessor visible)))

(defclass wall (crate)
  ())

(defclass vacuum (crate)
  ((full :initarg :full
         :accessor full
         :initform nil)))

(defclass moving (crate)
  ((v :initarg :v
      :accessor v)))
      :accessor v)
   (active :initarg :active
           :initform t
           :accessor active)))

(defclass player (moving)
  ())
  ((lamented :initarg lamented
             :initform nil
             :accessor lamented)))

;; Generic functions

(defgeneric update (obj)
(defgeneric update (self)
  (:documentation "Update a crate"))

(defgeneric east (obj)
(defgeneric east (self)
  (:documentation "Move crate east"))

(defgeneric west (obj)
(defgeneric west (self)
  (:documentation "Move crate west"))

(defgeneric north (obj)
(defgeneric north (self)
  (:documentation "Move crate north"))

(defgeneric south (obj)
(defgeneric south (self)
  (:documentation "Move crate south"))

(defgeneric visual (obj)
(defgeneric visual (self)
  (:documentation "Get visual representation for a crate"))

(defgeneric escape (crate)


@@ 74,68 95,92 @@

;; Methods

(defmethod update ((obj crate))
(defmethod update ((self crate))
  (format t "update crate "))

(defmethod update ((obj wall))
(defmethod update ((self wall))
  (format t "update wall ")
  (call-next-method))

(defmethod update ((obj moving))
(defmethod update ((self vacuum))
  (format t "update vacuum ")
  (let ((crate (find-at-of-type (x self) (y self) 0 'moving)))
    (when crate
      (setf (active crate) nil)
      (when (typep crate 'player)
        (setf (lamented crate) t)
        (setf (full self) t))))
  (call-next-method))

(defmethod update ((self moving))
  (format t "update moving ")
  (let ((v (v obj)))
    (ecase v (:east  (east obj))
             (:west  (west obj))
             (:north (north obj))
             (:south (south obj))))
  (when (active self)
    (let ((v (v self)))
      (ecase v (:east  (east self))
             (:west  (west self))
             (:north (north self))
             (:south (south self)))))
  (call-next-method))

(defmethod update ((obj player))
(defmethod update ((self player))
  (format t "update player ")
  (call-next-method))

(defmethod visual ((obj wall))
(defmethod visual ((self crate))
  (when (visible self)
    (call-next-method)))

(defmethod visual ((self wall))
  #\x)

(defmethod visual ((obj player))
  #\o)
(defmethod visual ((self player))
  (if (active self)
      #\o
      nil))

(defmethod visual ((self vacuum))
  (if (full self)
      #\V
      #\v))

(defmethod west ((obj moving))
(defmethod west ((self moving))
  (format t "west~%")
  (let* ((x (- (x obj) 1))
         (crate (find-at x (y obj) (z obj))))
  (let* ((x (- (x self) 1))
         (crate (find-at x (y self) (z self))))
    (if (< x 0)
        (escape obj)
        (escape self)
        (if crate
            (collide obj crate)
            (setf (x obj) x)))))
            (collide self crate)
            (setf (x self) x)))))

(defmethod east ((obj moving))
  (let* ((x (+ (x obj) 1))
         (crate (find-at x (y obj) (z obj))))
(defmethod east ((self moving))
  (let* ((x (+ (x self) 1))
         (crate (find-at x (y self) (z self))))
    (if (>= x *level-width*)
        (escape obj)
        (escape self)
        (if crate
            (collide obj crate)
            (setf (x obj) x)))))
            (collide self crate)
            (setf (x self) x)))))

(defmethod north ((obj moving))
  (let* ((y (+ (y obj) 1))
         (crate (find-at (x obj) y (z obj))))
(defmethod north ((self moving))
  (let* ((y (+ (y self) 1))
         (crate (find-at (x self) y (z self))))
    (if (>= y *level-height*)
        (escape obj)
        (escape self)
        (if crate
            (collide obj crate)
            (setf (y obj) y)))))
            (collide self crate)
            (setf (y self) y)))))

(defmethod south ((obj moving))
  (let* ((y (- (y obj) 1))
         (crate (find-at (x obj) y (z obj))))
(defmethod south ((self moving))
  (let* ((y (- (y self) 1))
         (crate (find-at (x self) y (z self))))
    (if (< y 0)
        (escape obj)
        (escape self)
        (if crate
            (collide obj crate)
            (setf (y obj) y)))))
            (collide self crate)
            (setf (y self) y)))))

(defmethod escape ((crate player))
  (setf *running* nil))
(defmethod escape ((self moving))
  (setf (active self) nil)
  (when (typep self 'player)
    (setf (lamented self) t)))

M src/level.lisp => src/level.lisp +11 -7
@@ 16,16 16,20 @@

(defparameter *running* t)
(defparameter *level* (list))
(defparameter *level-width* 32)
(defparameter *level-height* 24)
(defparameter *level-width* 8)
(defparameter *level-height* 4)

;; Methods

(defmethod update ((obj list))
(defmethod update ((self list))
  (when *running* (loop for crate in *level*
                        do (update crate)))
                        do (update crate)
                           (when (and (typep crate 'player)
                                      (lamented crate))
                             (setf *running* nil))))
  *running*)

(defmethod render ((obj list))
  (loop for crate in *level*
        do (render crate)))
(defmethod render ((self list))
  (when *running*
    (loop for crate in *level*
          do (render crate))))

M src/main.lisp => src/main.lisp +6 -4
@@ 46,8 46,9 @@

(defun run (level)
  (unless *errors*
    (loop while (update level)
          do (ui-render level))))
    (loop while *running*
          do (ui-render level)
             (update level))))

(defun usage ()
  (opts:describe


@@ 74,8 75,9 @@
       (loop for (,option ,value) on ,opts-not-empty by #'cddr
             do (case ,option ,@clauses)))))

(setf *level* (cons (make-instance 'wall   :x 2 :y 2 :z 0) *level*))
(setf *level* (cons (make-instance 'player :x 5 :y 4 :z 0) *level*))
(setf *level* (cons (make-instance 'wall   :x 1 :y 1 :z 0) *level*))
(setf *level* (cons (make-instance 'vacuum :x 2 :y 1 :z -1) *level*))
(setf *level* (cons (make-instance 'player :x 4 :y 1 :z 0) *level*))
(setf (v (car *level*)) :west)

(defun main ()

M src/textual.lisp => src/textual.lisp +2 -1
@@ 39,7 39,8 @@
                      (z (z crate))
                      (v (visual crate))
                      (line (aref lines y)))
                 (setf (aref line x) v))))
                 (when v
                   (setf (aref line x) v)))))
    (format t "~%+~A+~%" bar)
    (loop for line across lines
          do (format t "|~A|~%" line))