M sand.el +14 -3
@@ 45,6 45,7 @@
(defvar sand//representations
(ht ('sand "o")
('rock "@")
+ ('boulder "V")
('glass "a")
('ledge "_")
('angle-left "/")
@@ 92,7 93,7 @@
(remove item sand//spawnable-items)))
(defvar sand//blowupable-items
- (list 'sand 'rock 'glass 'antimatter 'balloon))
+ (list 'sand 'rock 'boulder 'glass 'antimatter 'balloon))
(defun sand//blowupable (item)
"Return whether ITEM can be blown up."
@@ 329,6 330,7 @@ Each item in MESSAGES is a different lin
(sand//insert-toggleable-item-description 'sand "falls down")
(sand//insert-toggleable-item-description 'rock "falls through sand")
(sand//insert-toggleable-item-description 'glass "crushed by rock")
+ (sand//insert-toggleable-item-description 'boulder "like rock, but falls twice as fast")
(sand//insert-toggleable-item-description 'antimatter "annihilates what it touches")
(sand//insert-toggleable-item-description 'balloon "floats up")
(sand//insert-toggleable-item-description 'bomb "explodes when it stops moving")
@@ 428,7 430,7 @@ Each item in MESSAGES is a different lin
t))
((seq-contains-p sand//consuming-items to-thing) t)
((seq-contains-p sand//consuming-items from-thing) t)
- ((eq from-thing 'rock)
+ ((seq-contains-p '(rock boulder) from-thing)
(seq-contains-p '(sand glass) to-thing))))
(defun sand//direction-to-drop (row column)
@@ 604,7 606,16 @@ Return the vector by which to move the c
(delta-column (elt step 1))
(to-row (+ row delta-row))
(to-column (+ column delta-column)))
- (sand//move-sand row column to-row to-column)))))))
+ (sand//move-sand row column to-row to-column)
+
+ (when (equal this-cell 'boulder)
+ ;;just do it again!
+ (let* ((step (sand//direction-to-drop to-row to-column))
+ (delta-row (elt step 0))
+ (delta-column (elt step 1))
+ (second-to-row (+ to-row delta-row))
+ (second-to-column (+ to-column delta-column)))
+ (sand//move-sand to-row to-column second-to-row second-to-column)))))))))
(defun sand/blank-board ()
"Make the entire board blank."
M sand.tests.el +20 -0
@@ 39,6 39,11 @@ BODY is the body code."
(should (sand//can-drop-to 'antimatter 'smoke))
(should (sand//can-drop-to 'antimatter 'smoke1)))
+(ert-deftest can-drop-to/boulder ()
+ (should (sand//can-drop-to 'boulder nil))
+ (should-not (sand//can-drop-to 'boulder 'ledge))
+ (should (sand//can-drop-to 'boulder 'glass)))
+
(ert-deftest direction-to-drop/balloon ()
(sand//with-new-board
(setf (sand//at 0 3) 'balloon)
@@ 91,6 96,12 @@ BODY is the body code."
(should (equal [1 0]
(sand//direction-to-drop 2 3)))))
+(ert-deftest direction-to-drop/boulder ()
+ (sand//with-new-board
+ (setf (sand//at 4 4) 'boulder)
+ (should (equal [1 0]
+ (sand//direction-to-drop 4 4)))))
+
(ert-deftest tick-cell/bare-balloon ()
(sand//with-new-board
(setf (sand//at 5 5) 'balloon)
@@ 252,6 263,15 @@ Like this:
(setf non-nil (1+ non-nil)))))
(should (equal non-nil 3)))))
+(ert-deftest tick-cell/boulder ()
+ (sand//with-new-board
+ (setf (sand//at 4 4) 'boulder)
+ (sand//tick-cell 4 4)
+ (should-not (sand//at 4 4))
+ (should-not (sand//at 5 4))
+ (should (equal (sand//at 6 4)
+ 'boulder))))
+
(ert-deftest move-sand/into-smoke ()
(sand//with-new-board
(setf (sand//at 4 5) 'antimatter)
M todo.org +3 -0
@@ 106,3 106,6 @@ CLOSED: [2023-01-04 Wed 00:44]
CLOSED: [2023-01-09 Mon 23:48]
* DONE make sand//with-new-board catch errors, reset board
CLOSED: [2023-01-15 Sun 22:02]
+* DONE heavy thing that moves twice per timestep
+CLOSED: [2023-01-15 Sun 22:42]
+* TODO make boulder/rock have better representations