Lots of changes, bad commit message

NOTES.org

@@ -6,9 +6,7 @@ http://www.utf8-chartable.de/unicode-utf8-table.pl?utf8=0x
 ** DONE Get bearlibterminal autowrapped and basic window working.
 CLOSED: [2016-01-01 Fri 22:52]
 ** High Priority
-*** TODO Randomly place ally tombs
-- [ ] Player can wake up allies by entering room
-*** TODO Base random placement off center of room, not edges.
+*** TODO Make nearest-open-tile able to use self as the tile
 *** TODO Create enemy AI
 - [ ] Detect whether player can be seen
 - [ ] Move to player
@@ -18,6 +16,12 @@ CLOSED: [2016-01-01 Fri 22:52]
 - [ ] Detect whether enemies can be seen
 - [ ] If enemies, move to them and attack.
 - [ ] If not enemies, move toward player.
+*** TODO Add status line section for current attack
+*** DONE Base random enemy/tomb placement off center of room, not edges
+CLOSED: [2016-01-11 Mon 01:55]
+*** DONE Randomly place ally tombs
+CLOSED: [2016-01-11 Mon 01:28]
+- [X] Player can wake up allies by entering room
 *** DONE Randomly place enemies
 CLOSED: [2016-01-11 Mon 00:32]
 *** DONE Create player character

src/crypts-and-corpses.lisp

@@ -77,12 +77,14 @@
    (health-regen :initarg :health-regen :initform 1 :type fixnum)
    (color :initarg :color :initform (color-from-name "#1919ff"))))
 
-(defclass tomb (tile-entity)
+(defclass tomb (floor-tile)
   ((codepoint :initform #x2616)
-   (color :initform (color-from-name "yellow"))))
+   (color :initform (color-from-name "yellow"))
+   (awakened :initform nil :reader awakened-p :accessor awakened)))
 
 (defclass minion (mobile)
-  ((color :initarg :color :initform (color-from-name "yellow"))))
+  ((color :initarg :color :initform (color-from-name "yellow"))
+   (codepoint :initform #x265f)))
 
 (defun calc-coord (location map)
   (values (mod location (game-map-width map)) (floor (/ location (game-map-width map)))))
@@ -248,30 +250,26 @@
 
 (defmethod bash-left ((object player-character) map)
   (let* ((location (1- (slot-value object 'location)))
-         (potential-target (gethash location (game-map-mobiles map)))
-         (target (and potential-target (typep potential-target 'mobile))))
-    (when target
+         (target (gethash location (game-map-mobiles map))))
+    (when (and target (typep target 'mobile))
       (decf (slot-value target 'health) (slot-value object 'melee-attack-damage)))))
 
 (defmethod bash-right ((object player-character) map)
   (let* ((location (1+ (slot-value object 'location)))
-         (potential-target (gethash location (game-map-mobiles map)))
-         (target (and potential-target (typep potential-target 'mobile))))
-    (when target
+         (target (gethash location (game-map-mobiles map))))
+    (when (and target (typep target 'mobile))
       (decf (slot-value target 'health) (slot-value object 'melee-attack-damage)))))
 
 (defmethod bash-up ((object player-character) map)
   (let* ((location (- (slot-value object 'location) (game-map-width map)))
-         (potential-target (gethash location (game-map-mobiles map)))
-         (target (and potential-target (typep potential-target 'mobile))))
-    (when target
+         (target (gethash location (game-map-mobiles map))))
+    (when (and target (typep target 'mobile))
       (decf (slot-value target 'health) (slot-value object 'melee-attack-damage)))))
 
 (defmethod bash-down ((object player-character) map)
   (let* ((location (+ (slot-value object 'location) (game-map-width map)))
-         (potential-target (gethash location (game-map-mobiles map)))
-         (target (and potential-target (typep potential-target 'mobile))))
-    (when target
+         (target (gethash location (game-map-mobiles map))))
+    (when (and target (typep target 'mobile))
       (decf (slot-value target 'health) (slot-value object 'melee-attack-damage)))))
 
 (defun intro-message ()
@@ -442,24 +440,26 @@
                (set-location floor x y map)
                (setf (gethash (calc-location x y map) terrain) floor)))))))))
 
+(defun room-center (room map)
+  (with-slots ((x1 crawler::x1) (x2 crawler::x2) (y1 crawler::y1) (y2 crawler::y2)) room
+    (calc-location (floor (+ x2 x1) 2) (floor (+ y2 y1) 2) map)))
+
 (defun spawn-enemies (map player)
   (loop for room in (crawler::rooms (game-map-dungeon map))
         when (not (equal room (find-room (get-location player) map))) do
-          (with-slots ((x1 crawler::x1) (x2 crawler::x2) (y1 crawler::y1) (y2 crawler::y2)) room
-            (dotimes (times (random 3))
-              (let* ((location (nearest-open-tile (gethash (calc-location x1 y1 map) (game-map-terrain map)) map))
-                     (enemy (make-instance 'enemy :location location)))
-                (when location
-                  (setf (gethash location (game-map-mobiles map)) enemy)))))))
+          (dotimes (times (random 3))
+            (let* ((location (nearest-open-tile (gethash (room-center room map) (game-map-terrain map)) map))
+                   (enemy (make-instance 'enemy :location location)))
+              (when location
+                (setf (gethash location (game-map-mobiles map)) enemy))))))
 
 (defun spawn-tombs (map)
   (loop for room in (crawler::rooms (game-map-dungeon map)) do
-    (with-slots ((x1 crawler::x1) (x2 crawler::x2) (y1 crawler::y1) (y2 crawler::y2)) room
-      (when (= 2 (random 5))
-        (let* ((location (nearest-open-tile (gethash (calc-location x2 y2 map) (game-map-terrain map)) map))
-               (tomb (make-instance 'tomb :location location)))
-                (when location
-                  (setf (gethash location (game-map-terrain map)) tomb)))))))
+    (when (= 2 (random 3))
+      (let* ((location (nearest-open-tile (gethash (room-center room map) (game-map-terrain map)) map))
+             (tomb (make-instance 'tomb :location location)))
+        (when location
+          (setf (gethash location (game-map-terrain map)) tomb))))))
 
 (defun initialize-map (map player)
   (fill-map-from-crawler map player)
@@ -545,6 +545,31 @@
       (setf height (game-map-height map)))
     (make-instance 'viewport :width width :height height)))
 
+(defun find-tomb-rooms-with-tomb (map)
+  (labels ((tombp (tile) (typep tile 'tomb)))
+    (let ((tombs (remove-if-not #'tombp (alexandria:hash-table-values (game-map-terrain map)))))
+      (loop for tomb in tombs
+            as room = (find-room (get-location tomb) map)
+            as pair = (list tomb room)
+            collect pair))))
+
+(defun spawn-minion (tomb map)
+  (let* ((location (nearest-open-tile tomb map))
+         (minion (make-instance 'minion :location location)))
+    (setf (gethash location (game-map-mobiles map)) minion)))
+
+(defun wake-up-the-dead (map player)
+  (let ((player-room (find-room (get-location player) map))
+        (tomb-rooms (find-tomb-rooms-with-tomb map)))
+    (loop for tomb-room in tomb-rooms
+          when (and player-room
+                    tomb-room
+                    (equal player-room (cadr tomb-room))
+                    (not (awakened (car tomb-room)))) do
+            (let ((tomb (car tomb-room)))
+              (setf (awakened tomb) t)
+              (spawn-minion tomb map)))))
+
 (defun end-of-turn-tasks (player map)
   (maphash (lambda (location object)
              (when (typep object 'mobile)
@@ -553,20 +578,23 @@
                      (setf (slot-value object 'location) nil)
                      (remhash location (game-map-mobiles map)))
                    (end-of-turn object)))) (game-map-mobiles map))
+  (wake-up-the-dead map player)
   (make-dijkstra-map (list player) 'player-map-value (game-map-terrain map))
   (make-dijkstra-map
    (remove-if-not #'enemy-p
                   (alexandria:hash-table-values (game-map-mobiles map)))
    'enemy-map-value (game-map-terrain map)))
 
-(defun write-status-to-terminal (player prev-key)
+(defun write-status-to-terminal (player prev-key map)
   (declare (ignore prev-key))
   (multiple-value-bind (width height) (get-window-size)
     (declare (ignore width))
-    (terminal-color (color-from-name "white"))
-    (terminal-print 0 (1- height) (format nil "H: ~d M: ~d"
-                                          (slot-value player 'health)
-                                          (slot-value player 'mana)))))
+    (multiple-value-bind (x y) (calc-coord (get-location player) map)
+      (terminal-color (color-from-name "white"))
+      (terminal-print 0 (1- height) (format nil "Health: ~d Mana: ~d Location: (~d, ~d)"
+                                            (slot-value player 'health)
+                                            (slot-value player 'mana)
+                                            x y)))))
 
 (defun display-lose ()
   (terminal-clear)
@@ -603,7 +631,7 @@
               (end-of-turn-tasks player map))
             (terminal-clear)
             (write-map-to-terminal player map viewport)
-            (write-status-to-terminal player prev-key)
+            (write-status-to-terminal player prev-key map)
             (terminal-refresh))
         until (or (= key bearlibterminal-ffi:+tk-close+)
                   (= key bearlibterminal-ffi:+tk-escape+)