~octaspire/crates2

1b34652f45bcd175ab7935b1d7f8e71c5348dc84 — octaspire 2 months ago c94b5b1
Implement smoother interpolated visual movement

 * Game logic is run in discrete steps. Crate can be, for example,
   in location (2, 0, 0) or (1, 0, 0), but not in (1.5, 0, 0).
   However, the visual representation can display the crates in
   continuous manner - to interpolate between starting position
   and ending position.

   Add a TAIL slot to MOVING crates. This can hold a position
   somewhere between the starting and ending position. This can
   represent a place in between regular movement, but also
   any other position. For example SLOPEs and TURNSTILEs
   set the TAIL to their own location - this way the MOVING
   crate seems to travel through them.

   It is up to the visual representation if it will use TAIL
   slot or not. It can draw the representation in discrete
   steps, or more smoothly.
M .builds/debian_stretch.yml => .builds/debian_stretch.yml +2 -2
@@ 16,5 16,5 @@ tasks:
        make test
    - peek-results: |
        cd ~/quicklisp/local-projects/crates2
        head -n 50 got.txt
        tail -n 48 got.txt
        head -n 67 got.txt
        tail -n 65 got.txt

M crates2.asd => crates2.asd +1 -1
@@ 18,8 18,8 @@
  :components ((:module src
                :components
                ((:file "package")
                 (:file "utils")
                 (:file "classes")
                 (:file "utils")
                 (:file "crate")
                 (:file "moving")
                 (:file "simple-crates")

M src/classes.lisp => src/classes.lisp +4 -1
@@ 38,7 38,10 @@
             :accessor velocity)
   (active :initarg :active
           :initform t
           :accessor active)))
           :accessor active)
   (tail :initarg :tail
           :initform nil
           :accessor moving-tail)))

(defclass wall (crate)
  ())

M src/crate.lisp => src/crate.lisp +9 -1
@@ 37,10 37,18 @@
(defgeneric handle-input (self input)
  (:documentation "React to input"))

(defgeneric is-at-p (self x y z)
  (:documentation "Predicate telling whether crate is at X Y Z"))

;; Methods

(defmethod update ((self crate)))

(defmethod visual ((self crate))
  (when (crate-visible self)
    (call-next-method)))
\ No newline at end of file
    (call-next-method)))

(defmethod is-at-p ((self crate) x y z)
  (and (= (crate-x self) x)
       (= (crate-y self) y)
       (= (crate-z self) z)))
\ No newline at end of file

M src/main.lisp => src/main.lisp +6 -3
@@ 97,13 97,16 @@ This is similar to 'test' but runs much slower."
    (init-visual-hash)
    (request-next-level)
    (let ((str (make-array 2048 :element-type 'character :fill-pointer 0 :adjustable t))
          (log-input (getf options :log-input)))
          (log-input (getf options :log-input))
          (half-frame-duration (* 0.5 *frame-duration*)))
      (with-output-to-string (s str)
        (loop while (and (runningp)
                         (or (not *test-run*)
                             (< *update-counter* *test-run-max-updates*)))
              do (setf *input* nil)
                 (ui-render *level*)
                 (ui-render *level* 0)
                 (sleep half-frame-duration)
                 (ui-render *level* 1)
                 (let ((input (ui-input)))
                   (when log-input
                     (format s (if (keywordp input) "~%~S " "~S " ) input))


@@ 120,7 123,7 @@ This is similar to 'test' but runs much slower."
                   (when log-input
                     (format s "~%----------LEVEL ~A----------~%" *level-number*)))
                 (incf *update-counter*)
                 (sleep *frame-duration*))
                 (sleep half-frame-duration))
        (when (>= *update-counter* *test-run-max-updates*)
          (format t "~%CRATES2: WARNING EXECUTION STOPPED ON TOO LARGE UPDATE COUNT~%"))
        (setf str (nstring-downcase str))

M src/moving.lisp => src/moving.lisp +42 -4
@@ 34,6 34,7 @@
  (eq (velocity self) :zero))

(defmethod update ((self moving))
  (setf (moving-tail self) nil)
  (when (active self)
    (let ((v (velocity self)))
      (ecase v


@@ 44,6 45,43 @@
        (:zero))))
  (call-next-method))

(defmethod tail-x ((self moving))
  (let ((tail (moving-tail self)))
    (if tail
        (first tail)
        (crate-x self))))

(defmethod tail-y ((self moving))
  (let ((tail (moving-tail self)))
    (if tail
        (second tail)
        (crate-y self))))

(defmethod tail-z ((self moving))
  (let ((tail (moving-tail self)))
    (if tail
        (third tail)
        (crate-z self))))

(defmethod move-to ((self moving) x y z)
  (let ((old-x (crate-x self))
        (old-y (crate-y self))
        (old-z (crate-z self)))
    (unless (is-at-p self x y z)
      (let ((dx (- x old-x))
            (dy (- y old-y))
            (dz (- z old-z)))
        (setf (crate-x self) x
              (crate-y self) y
              (crate-z self) z)
        (set-tail self
                  (+ old-x (/ dx 2))
                  (+ old-y (/ dy 2))
                  (+ old-z (/ dz 2)))))))

(defmethod set-tail ((self moving) x y z)
  (setf (moving-tail self) (list x y z)))

(defmethod west ((self moving))
  (let* ((x (- (crate-x self) 1))
         (crate (find-at x (crate-y self) (crate-z self))))


@@ 51,7 89,7 @@
        (lament self)
        (if crate
            (handle-collision self crate)
            (setf (crate-x self) x)))))
            (move-to self x (crate-y self) (crate-z self))))))

(defmethod east ((self moving))
  (let* ((x (+ (crate-x self) 1))


@@ 60,7 98,7 @@
        (lament self)
        (if crate
            (handle-collision self crate)
            (setf (crate-x self) x)))))
            (move-to self x (crate-y self) (crate-z self))))))

(defmethod north ((self moving))
  (let* ((y (- (crate-y self) 1))


@@ 69,7 107,7 @@
        (lament self)
        (if crate
            (handle-collision self crate)
            (setf (crate-y self) y)))))
            (move-to self (crate-x self) y (crate-z self))))))

(defmethod south ((self moving))
  (let* ((y (+ (crate-y self) 1))


@@ 78,7 116,7 @@
        (lament self)
        (if crate
            (handle-collision self crate)
            (setf  (crate-y self) y)))))
            (move-to self (crate-x self) y (crate-z self))))))

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

M src/textual.lisp => src/textual.lisp +8 -8
@@ 206,25 206,25 @@
                   (concatenate 'string result (format nil "~vd" cw i))))
    result))

(defun ui-render (level)
(defun ui-render (level step)
  (let ((lines (empty-level))
        (x-axis (x-axis *level-width*))
        (bar (format nil "~v@{~A~:*~}" (* cw *level-width*) #\-)))
    (loop for crate in level
          do (progn
               (let* ((x (crate-x crate))
                      (y (crate-y crate))
                      (z (crate-z crate))
               (let* ((x (if (and (= step 0) (typep crate 'moving)) (tail-x crate) (crate-x crate)))
                      (y (if (and (= step 0) (typep crate 'moving)) (tail-y crate) (crate-y crate)))
                      (z (if (and (= step 0) (typep crate 'moving)) (tail-z crate) (crate-z crate)))
                      (vids (visual crate)))
                 (loop for vid in vids
                       do
                          (let ((viv (gethash vid *visual-hash*)))
                            (when viv
                              (loop for liney from 0 to (- ch 1)
                                    do (let ((str (aref viv liney))
                                             (line (aref lines (+ (* y ch) liney)))
                                             (deltax (* x cw)))
                                         (setf line (replace-substr-at-transparent-whitespace line deltax str))))))))))
                                        do (let ((str (aref viv liney))
                                                 (line (aref lines (+ (truncate (* y ch)) liney)))
                                                 (deltax (truncate (* x cw))))
                                             (setf line (replace-substr-at-transparent-whitespace line deltax str))))))))))
    (format t "~%  ~A~%" x-axis)
    (format t "  +~A+ Level ~A~%" bar *level-number*)
    (loop for line across lines

M src/utils.lisp => src/utils.lisp +9 -6
@@ 94,16 94,19 @@ directions."
          (:zero  :zero)))
      :zero))

(defun move-to (crate x y z)
(defmethod move-to ((self moving) x y z)
  (setf (crate-x crate) x)
  (setf (crate-y crate) y)
  (setf (crate-z crate) z))

(defun move-other-to-my-side (i other side)
(defmethod set-tail-to-me (i (other moving))
  (set-tail other (crate-x i) (crate-y i) (crate-z i)))

(defmethod move-other-to-my-side (i (other moving) side)
  "Move crate OTHER to SIDE of crate I"
  (ecase side
    (:north (move-to other (crate-x i) (- (crate-y i) 1) (crate-z i)))
    (:south (move-to other (crate-x i) (+ (crate-y i) 1) (crate-z i)))
    (:east  (move-to other (+ (crate-x i) 1) (crate-y i) (crate-z i)))
    (:west  (move-to other (- (crate-x i) 1) (crate-y i) (crate-z i)))
    (:north (move-to other (crate-x i) (- (crate-y i) 1) (crate-z i)) (set-tail-to-me i other))
    (:south (move-to other (crate-x i) (+ (crate-y i) 1) (crate-z i)) (set-tail-to-me i other))
    (:east  (move-to other (+ (crate-x i) 1) (crate-y i) (crate-z i)) (set-tail-to-me i other))
    (:west  (move-to other (- (crate-x i) 1) (crate-y i) (crate-z i)) (set-tail-to-me i other))
    (:zero  nil)))