Make AI happen

src/crypts-and-corpses.lisp

@@ -33,20 +33,22 @@
   ((width :initarg :width :type fixnum :initform 1)
    (height :initarg :height :type fixnum :initform 1)
    (location :initarg :location :initform 0 :type fixnum :reader get-location)
-   (color :initarg :color :initform (color-from-name "#ffffff"))))
+   (color :initarg :color :initform (color-from-name "#ffffff"))
+   (blocks-light :initform nil :reader get-blocks-light)))
 
 (defclass tile-entity (entity)
   ((codepoint :initarg :codepoint :initform #x3f :type fixnum)))
 
 (defclass wall (tile-entity)
   ((codepoint :initarg :codepoint :initform #x23 :type fixnum)
-   (color :initarg :color :initform (color-from-name "#999999"))))
+   (color :initarg :color :initform (color-from-name "#999999"))
+   (blocks-light :initform t)))
 
 (defclass floor-tile (tile-entity)
   ((codepoint :initarg :codepoint :initform #xb7 :type fixnum)
    (color :initarg :color :initform (color-from-name "#3f3f3f"))
-   (player-map-value :initform nil)
-   (enemy-map-value :initform nil)))
+   (player-map-value :initform nil :reader get-player-map-value)
+   (enemy-map-value :initform nil :reader get-enemy-map-value)))
 
 (defclass viewport (entity)
   ((width :initarg :width :type fixnum :initform 99)
@@ -59,7 +61,8 @@
    (max-health :initarg :health :type fixnum :initform 10)
    (max-mana :initarg :mana :type fixnum :initform 10)
    (health-regen :initarg :health-regen :initform 0 :type fixnum)
-   (mana-regen :initarg :mana-regen :initform 0 :type fixnum)))
+   (mana-regen :initarg :mana-regen :initform 0 :type fixnum)
+   (vision-range :initform 4 :initarg :vision-rage :type fixnum :reader get-vision-range)))
 
 (defclass player-character (mobile)
   ((health :initarg :health :type fixnum :initform 10)
@@ -73,18 +76,19 @@
 
 (defclass enemy (mobile)
   ((codepoint :initform #x263a)
-   (melee-attack-damage :initarg :ranged-attack-damage :initform 1 :type fixnum)
+   (melee-attack-damage :initarg :melee-attack-damage :initform 1 :type fixnum)
    (health-regen :initarg :health-regen :initform 1 :type fixnum)
    (color :initarg :color :initform (color-from-name "#1919ff"))))
 
 (defclass tomb (floor-tile)
   ((codepoint :initform #x2616)
-   (color :initform (color-from-name "yellow"))
+   (color :initform (color-from-name "#ffff00"))
    (awakened :initform nil :reader awakened-p :accessor awakened)))
 
 (defclass minion (mobile)
-  ((color :initarg :color :initform (color-from-name "yellow"))
-   (codepoint :initform #x265f)))
+  ((color :initarg :color :initform (color-from-name "#ffff00"))
+   (codepoint :initform #x2639)
+   (melee-attack-damage :initform 1 :type fixnum )))
 
 (defun calc-coord (location map)
   (values (mod location (game-map-width map)) (floor (/ location (game-map-width map)))))
@@ -308,13 +312,19 @@
       (maphash #'write-cell (game-map-terrain map))
       (maphash #'write-cell (game-map-mobiles map)))))
 
+(defun adjacent-open-tiles (tile map)
+  (when tile
+    (let* ((mobile-neighbors (mapcar #'get-location (get-neighbors tile map (game-map-mobiles map))))
+           (terrain-neighbors (mapcar #'get-location (get-neighbors tile map (game-map-terrain map) :filter-fun #'walkablep))))
+      (mapcar (lambda (item) (gethash item (game-map-terrain map)))
+              (remove-if (lambda (item) (find item mobile-neighbors))
+                         terrain-neighbors)))))
+
 ;; TODO: Update to be able to handle any distance, not just 1
+;; TODO: Update to include `tile' for consideration
 (defun nearest-open-tile (tile map)
   (declare (type entity tile))
-  (let* ((mobile-neighbors (mapcar #'get-location (get-neighbors tile map (game-map-mobiles map))))
-         (terrain-neighbors (mapcar #'get-location (get-neighbors tile map (game-map-terrain map) :filter-fun #'walkablep)))
-         (available-neighbors (remove-if (lambda (item) (find item mobile-neighbors)) terrain-neighbors)))
-    (first available-neighbors)))
+  (first (adjacent-open-tiles tile map)))
 
 (defun in-room-p (location map room)
   (declare (type crawler::dungeon-room room))
@@ -326,8 +336,9 @@
            (<= y y2)))))
 
 (defun find-room (location map)
-  (labels ((location-in-room-p (room) (in-room-p location map room)))
-    (find-if #'location-in-room-p (slot-value (slot-value map 'dungeon) 'crawler::rooms))))
+  (when location
+    (labels ((location-in-room-p (room) (in-room-p location map room)))
+      (find-if #'location-in-room-p (slot-value (slot-value map 'dungeon) 'crawler::rooms)))))
 
 (defun find-arc (x y x0 y0 map)
   (labels ((calc-location-map (x y) (calc-location x y map)))
@@ -448,7 +459,7 @@
   (loop for room in (crawler::rooms (game-map-dungeon map))
         when (not (equal room (find-room (get-location player) map))) do
           (dotimes (times (random 3))
-            (let* ((location (nearest-open-tile (gethash (room-center room map) (game-map-terrain map)) map))
+            (let* ((location (get-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))))))
@@ -456,7 +467,7 @@
 (defun spawn-tombs (map)
   (loop for room in (crawler::rooms (game-map-dungeon map)) do
     (when (= 2 (random 3))
-      (let* ((location (nearest-open-tile (gethash (room-center room map) (game-map-terrain map)) map))
+      (let* ((location (get-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))))))
@@ -492,8 +503,9 @@
       ;; Insert all source floor tiles in queue with priority and slot value zero
       (mapc (lambda (item)
               (with-slots (location) item
-                (setf (get-slot (gethash location tiles)) 0)
-                (cl-heap:enqueue pending (gethash location tiles) 0))) sources)
+                (when location
+                  (setf (get-slot (gethash location tiles)) 0)
+                  (cl-heap:enqueue pending (gethash location tiles) 0)))) sources)
       (loop as tile = (cl-heap:dequeue pending)
             while tile do
               (loop with value = (1+ (get-slot tile))
@@ -554,21 +566,22 @@
             collect pair))))
 
 (defun spawn-minion (tomb map)
-  (let* ((location (nearest-open-tile tomb map))
+  (let* ((location (get-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 wake-the-dead (map player)
+  (when (get-location 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)
@@ -578,7 +591,7 @@
                      (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)
+  (wake-the-dead map player)
   (make-dijkstra-map (list player) 'player-map-value (game-map-terrain map))
   (make-dijkstra-map
    (remove-if-not #'enemy-p
@@ -596,6 +609,92 @@
                                             (slot-value player 'mana)
                                             x y)))))
 
+(defun ally-p (mobile)
+  (typep mobile 'minion))
+
+(defun bash (basher bashee)
+  (decf (slot-value bashee 'health) (slot-value basher 'melee-attack-damage)))
+
+(defun can-see-player-p (mobile map player)
+  (multiple-value-bind (mob-x mob-y) (calc-coord (get-location mobile) map)
+    (multiple-value-bind (player-x player-y) (calc-coord (get-location player) map)
+      (or (equal (find-room (get-location mobile) map)
+                 (find-room (get-location player) map))
+          (let ((line (ortho-line mob-x mob-y player-x player-y))
+                (max (get-vision-range mobile)))
+            (loop with counter = 0
+                  as current = (pop line)
+                  while (and current (< counter max))
+                  as cur-loc = (calc-location (first current) (cadr current) map)
+                  as terrain = (gethash cur-loc (game-map-terrain map))
+                  as mobile  = (gethash cur-loc (game-map-mobiles map))
+                  while (and (or (not terrain) (not (get-blocks-light terrain)))
+                             (or (not mobile)  (not (get-blocks-light mobile))))
+                  finally (return (equal player mobile))))))))
+
+(defun move-toward-enemy (mobile map)
+  (let* ((tiles (adjacent-open-tiles mobile map))
+         (best-tile (first (sort tiles #'< :key #'get-enemy-map-value))))
+    (when best-tile
+      (remhash (get-location mobile) (game-map-mobiles map))
+      (setf (slot-value mobile 'location) (get-location best-tile))
+      (setf (gethash (get-location best-tile) (game-map-mobiles map)) mobile))))
+
+(defun distance-to-player (mobile map player &key (max 100))
+  (let* ((terrain (game-map-terrain map))
+         (tile (gethash (get-location mobile) terrain))
+         (player-tile (gethash (get-location player) terrain)))
+    (loop with counter = 0
+          while (and (not (equal tile player-tile)) (< counter max)) do
+            (incf counter)
+            (setf tile (first (sort (adjacent-open-tiles tile map) #'< :key #'get-player-map-value)))
+          finally (return counter))))
+
+(defun move-ally-toward-player (mobile map player)
+  (when (< 3 (distance-to-player mobile map player :max 3))
+    (move-toward-player mobile map)))
+
+(defun move-toward-player (mobile map)
+  (let* ((tiles (adjacent-open-tiles mobile map))
+         (best-tile (first (sort tiles #'< :key #'get-player-map-value))))
+    (when best-tile
+      (remhash (get-location mobile) (game-map-mobiles map))
+      (setf (slot-value mobile 'location) (get-location best-tile))
+      (setf (gethash (get-location best-tile) (game-map-mobiles map)) mobile))))
+
+(defun adjacent-enemies (mobile map)
+  (get-neighbors mobile map (game-map-mobiles map) :filter-fun #'enemy-p))
+
+(defun adjacent-allies-player (mobile map)
+  (get-neighbors mobile map (game-map-mobiles map) :filter-fun (lambda (mobile) (or (typep mobile 'player-character) (typep mobile 'minion)))))
+
+(defun ally-think-and-do (mobile player)
+  (declare (type minion mobile))
+  (let ((adjacent-enemy (first (adjacent-enemies mobile map))))
+    (cond
+      (adjacent-enemy (bash mobile adjacent-enemy))
+      ((can-see-player-p mobile map player) (move-toward-enemy mobile map))
+      (:otherwise (move-ally-toward-player mobile map player)))))
+
+(defun enemy-think-and-do (mobile player)
+  (declare (type enemy mobile))
+  (let ((adjacent-enemy (first (adjacent-allies-player mobile map))))
+    (cond
+      (adjacent-enemy (bash mobile adjacent-enemy))
+      ((can-see-player-p mobile map player) (move-toward-player mobile map)))))
+
+(defun allies-do-stuff (map player)
+  (labels ((curried-ally-think-and-do (mobile) (ally-think-and-do mobile player)))
+    (mapc #'curried-ally-think-and-do (remove-if-not #'ally-p (alexandria:hash-table-values (game-map-mobiles map))))))
+
+(defun enemies-do-stuff (map player)
+  (labels ((curried-enemy-think-and-do (mobile) (enemy-think-and-do mobile player)))
+    (mapc #'curried-enemy-think-and-do (remove-if-not #'enemy-p (alexandria:hash-table-values (game-map-mobiles map))))))
+
+(defun ai-do-stuff (map player)
+  (allies-do-stuff map player)
+  (enemies-do-stuff map player))
+
 (defun display-lose ()
   (terminal-clear)
   (terminal-print 0 0 "You lose!")
@@ -628,6 +727,7 @@
             (setf prev-key key)
             (unless (or (= key bearlibterminal-ffi:+tk-r+)
                         (= key bearlibterminal-ffi:+tk-m+))
+              (when (get-location player) (ai-do-stuff map player))
               (end-of-turn-tasks player map))
             (terminal-clear)
             (write-map-to-terminal player map viewport)