Bug fixes with various issues, start instructions

src/crypts-and-corpses.lisp

@@ -148,11 +148,12 @@
         (and tile (not (typep tile 'floor-tile))))))
 
 (defun bad-move-p (object map old-location new-location)
-  (let ((old-effective-location (calculate-effective-location object map old-location))
-        (new-effective-location (calculate-effective-location object map new-location)))
-    (or (out-of-bounds-p new-effective-location map)
-        (collision-p new-effective-location map)
-        (overrun-p old-effective-location new-effective-location map))))
+  (when old-location new-location object
+    (let ((old-effective-location (calculate-effective-location object map old-location))
+          (new-effective-location (calculate-effective-location object map new-location)))
+      (or (out-of-bounds-p new-effective-location map)
+          (collision-p new-effective-location map)
+          (overrun-p old-effective-location new-effective-location map)))))
 
 (defmethod update-location ((object entity) map old-location new-location)
   (unless (bad-move-p object map old-location new-location)
@@ -164,6 +165,17 @@
     (setf (gethash new-location (game-map-mobiles map)) object)
     (remhash old-location (game-map-mobiles map))))
 
+(defmethod update-location :after ((player player-character) map old-location new-location)
+  (declare (ignore old-location new-location))
+  (make-dijkstra-map (list player) 'player-map-value (game-map-terrain map)))
+
+(defmethod update-location :after ((enemy enemy) map old-location new-location)
+  (declare (ignore old-location new-location))
+  (make-dijkstra-map
+   (remove-if-not #'enemy-p
+                  (alexandria:hash-table-values (game-map-mobiles map)))
+   'enemy-map-value (game-map-terrain map)))
+
 (defmethod move-left ((object entity) map)
   (let ((old-location (slot-value object 'location))
         (new-location (1- (slot-value object 'location))))
@@ -294,30 +306,31 @@
     (aref mapping number)))
 
 (defun write-map-to-terminal (player map viewport)
-  (let* ((player-location (slot-value player 'location))
-         (current-room (find-room player-location map))
-         (vision-range (if current-room
-                           (with-slots ((x1 crawler::x1) (y1 crawler::y1) (x2 crawler::x2) (y2 crawler::y2)) current-room
-                             (list (list (1- x1) (1- y1))
-                                   (list x2 y2)))
-                           (progn
-                             (multiple-value-bind (x y) (calc-coord player-location map)
-                               (list (list (1- x) (1- y))
-                                     (list (1+ x) (1+ y))))))))
-    (labels ((write-cell (key tile)
-               (multiple-value-bind (x y) (calc-coord (- key (slot-value viewport 'location)) map)
-                 (let ((x1 (caar vision-range))
-                       (x2 (caadr vision-range))
-                       (y1 (cadar vision-range))
-                       (y2 (cadadr vision-range)))
-                   (when (and (>= x x1)
-                              (<= x x2)
-                              (>= y y1)
-                              (<= y y2))
-                     (terminal-color (slot-value tile 'color))
-                     (terminal-put x y (slot-value tile 'codepoint)))))))
-      (maphash #'write-cell (game-map-terrain map))
-      (maphash #'write-cell (game-map-mobiles map)))))
+  (when (get-location player)
+    (let* ((player-location (slot-value player 'location))
+           (current-room (find-room player-location map))
+           (vision-range (if current-room
+                             (with-slots ((x1 crawler::x1) (y1 crawler::y1) (x2 crawler::x2) (y2 crawler::y2)) current-room
+                               (list (list (1- x1) (1- y1))
+                                     (list x2 y2)))
+                             (progn
+                               (multiple-value-bind (x y) (calc-coord player-location map)
+                                 (list (list (1- x) (1- y))
+                                       (list (1+ x) (1+ y))))))))
+      (labels ((write-cell (key tile)
+                 (multiple-value-bind (x y) (calc-coord (- key (slot-value viewport 'location)) map)
+                   (let ((x1 (caar vision-range))
+                         (x2 (caadr vision-range))
+                         (y1 (cadar vision-range))
+                         (y2 (cadadr vision-range)))
+                     (when (and (>= x x1)
+                                (<= x x2)
+                                (>= y y1)
+                                (<= y y2))
+                       (terminal-color (slot-value tile 'color))
+                       (terminal-put x y (slot-value tile 'codepoint)))))))
+        (maphash #'write-cell (game-map-terrain map))
+        (maphash #'write-cell (game-map-mobiles map))))))
 
 (defun adjacent-open-tiles (tile map)
   (when tile
@@ -481,9 +494,14 @@
 
 (defun initialize-map (map player)
   (fill-map-from-crawler map player)
+  (update-location player map nil (get-location player))
   (setf (gethash (slot-value player 'location) (game-map-mobiles map)) player)
   (spawn-enemies map player)
   (spawn-tombs map)
+  (make-dijkstra-map
+   (remove-if-not #'enemy-p
+                  (alexandria:hash-table-values (game-map-mobiles map)))
+   'enemy-map-value (game-map-terrain map))
   map)
 
 (defun get-neighbors (tile map layer &key (filter-fun #'identity))
@@ -495,7 +513,7 @@
     (remove-if-not filter-fun (list w n e s))))
 
 (defun walkablep (tile)
-  (and tile (typep tile 'floor-tile)))
+  (and tile (or (typep tile 'floor-tile) (typep tile 'tomb))))
 
 (defun make-dijkstra-map (sources slot tiles)
   (labels ((get-slot (tile)
@@ -522,40 +540,6 @@
                       (cl-heap:enqueue pending neighbor (get-slot neighbor))))
       tiles)))
 
-(defun handle-input (key map viewport player prev-key)
-  (cond
-    ;; Ranged attack
-    ((equal prev-key bearlibterminal-ffi:+tk-r+)
-     (cond
-       ((= key bearlibterminal-ffi:+tk-up+) (shoot-up player map))
-       ((= key bearlibterminal-ffi:+tk-down+) (shoot-down player map))
-       ((= key bearlibterminal-ffi:+tk-right+) (shoot-right player map))
-       ((= key bearlibterminal-ffi:+tk-left+) (shoot-left player map))
-       ((= key bearlibterminal-ffi:+tk-enter+) t))) ; cancel
-    ;; Melee attack
-    ((equal prev-key bearlibterminal-ffi:+tk-m+)
-     (cond
-       ((= key bearlibterminal-ffi:+tk-up+) (bash-up player map))
-       ((= key bearlibterminal-ffi:+tk-down+) (bash-down player map))
-       ((= key bearlibterminal-ffi:+tk-right+) (bash-right player map))
-       ((= key bearlibterminal-ffi:+tk-left+) (bash-left player map))
-       ((= key bearlibterminal-ffi:+tk-enter+) t))) ; cancel
-    ;; Not a stateful command
-    (:otherwise
-     (cond
-       ((= key bearlibterminal-ffi:+tk-r+) t) ; Prepare for ranged
-       ((= key bearlibterminal-ffi:+tk-m+) t) ; Prepare for melee
-       ((= key bearlibterminal-ffi:+tk-enter+) t) ; idle
-       ((= key bearlibterminal-ffi:+tk-up+) (move-up player map))
-       ((= key bearlibterminal-ffi:+tk-down+) (move-down player map))
-       ((= key bearlibterminal-ffi:+tk-right+) (move-right player map))
-       ((= key bearlibterminal-ffi:+tk-left+) (move-left player map))
-       ((= key bearlibterminal-ffi:+tk-w+) (move-up viewport map))
-       ((= key bearlibterminal-ffi:+tk-a+) (move-left viewport map))
-       ((= key bearlibterminal-ffi:+tk-d+) (move-right viewport map))
-       ((= key bearlibterminal-ffi:+tk-s+) (move-down viewport map))
-       ((= key bearlibterminal-ffi:+tk-space+) (update-location viewport map (slot-value viewport 'location) (slot-value player 'location)))))))
-
 (defun create-viewport (map)
   (multiple-value-bind (width height) (get-window-size)
     (when (> width (game-map-width map))
@@ -598,12 +582,7 @@
                      (setf (slot-value object 'location) nil)
                      (remhash location (game-map-mobiles map)))
                    (end-of-turn object)))) (game-map-mobiles map))
-  (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
-                  (alexandria:hash-table-values (game-map-mobiles map)))
-   'enemy-map-value (game-map-terrain map)))
+  (wake-the-dead map player))
 
 (defun write-status-to-terminal (player prev-key map)
   (multiple-value-bind (width height) (get-window-size)
@@ -668,9 +647,7 @@
   (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))))
+      (update-location mobile map (get-location mobile) (get-location best-tile)))))
 
 (defun adjacent-enemies (mobile map)
   (get-neighbors mobile map (game-map-mobiles map) :filter-fun #'enemy-p))
@@ -705,8 +682,15 @@
   (allies-do-stuff map player)
   (enemies-do-stuff map player))
 
+(defun enemy-p (thing)
+  (typep thing 'enemy))
+
+(defun no-enemies-left-p (map)
+  (not (find-if #'enemy-p (alexandria:hash-table-values (game-map-mobiles map)))))
+
 (defun display-lose ()
   (terminal-clear)
+  (terminal-color (color-from-name "white"))
   (terminal-print 0 0 "You lose!")
   (terminal-print 0 1 "Press escape key to exit.")
   (terminal-refresh)
@@ -715,17 +699,73 @@
 
 (defun display-win ()
   (terminal-clear)
+  (terminal-color (color-from-name "white"))
   (terminal-print 0 0 "You win!")
   (terminal-print 0 1 "Press escape key to exit.")
   (terminal-refresh)
   (loop as key = (terminal-read)
         while (not (eq key bearlibterminal-ffi:+tk-escape+))))
 
-(defun enemy-p (thing)
-  (typep thing 'enemy))
 
-(defun no-enemies-left-p (map)
-  (not (find-if #'enemy-p (alexandria:hash-table-values (game-map-mobiles map)))))
+(defun display-instructions ()
+  (multiple-value-bind (win-width win-height) (get-window-size)
+    (terminal-clear)
+    (terminal-color (color-from-name "white"))
+    (terminal-print 0 0 "Instructions")
+    (terminal-print 0 1 "This is you: ")
+    (terminal-color (color-from-name "#800080"))
+    (terminal-put 13 1 #x2639)
+    (terminal-color (color-from-name "white"))
+    (terminal-print 0 2 "Move with arrow keys.")
+    (terminal-print 0 3 "Ranged attack with r. Choose a direction. Press enter to cancel. Canceling still takes up your turn. Costs 5 mana.")
+    (terminal-print 0 4 "Melee attack with m. Choose a direction. Press enter to cancel. Canceling still takes up your turn.")
+    (terminal-print 0 5 "You do not regenerate health.")
+    (terminal-print 0 6 "You regenerate 3 mana per a turn (including turns in which you use mana)")
+    (terminal-color (color-from-name "#ffff00"))
+    (terminal-put 13 7 #x2616)
+    (terminal-color (color-from-name "white"))
+    (terminal-color (color-from-name "#ffff00"))
+    (terminal-put 13 8 #x2639)
+    (terminal-color (color-from-name "white"))
+    (terminal-color (color-from-name "#1919ff"))
+    (terminal-put 13 9 #x263a)
+    (terminal-color (color-from-name "white"))
+    (terminal-refresh)))
+
+(defun handle-input (key map viewport player prev-key)
+  (cond
+    ;; Ranged attack
+    ((equal prev-key bearlibterminal-ffi:+tk-r+)
+     (cond
+       ((= key bearlibterminal-ffi:+tk-up+) (shoot-up player map))
+       ((= key bearlibterminal-ffi:+tk-down+) (shoot-down player map))
+       ((= key bearlibterminal-ffi:+tk-right+) (shoot-right player map))
+       ((= key bearlibterminal-ffi:+tk-left+) (shoot-left player map))
+       ((= key bearlibterminal-ffi:+tk-enter+) t))) ; cancel
+    ;; Melee attack
+    ((equal prev-key bearlibterminal-ffi:+tk-m+)
+     (cond
+       ((= key bearlibterminal-ffi:+tk-up+) (bash-up player map))
+       ((= key bearlibterminal-ffi:+tk-down+) (bash-down player map))
+       ((= key bearlibterminal-ffi:+tk-right+) (bash-right player map))
+       ((= key bearlibterminal-ffi:+tk-left+) (bash-left player map))
+       ((= key bearlibterminal-ffi:+tk-enter+) t))) ; cancel
+    ;; Not a stateful command
+    (:otherwise
+     (cond
+       ((= key bearlibterminal-ffi:+tk-r+) t) ; Prepare for ranged
+       ((= key bearlibterminal-ffi:+tk-m+) t) ; Prepare for melee
+       ((= key bearlibterminal-ffi:+tk-enter+) t) ; idle
+       ((= key bearlibterminal-ffi:+tk-h+) (display-instructions))
+       ((= key bearlibterminal-ffi:+tk-up+) (move-up player map))
+       ((= key bearlibterminal-ffi:+tk-down+) (move-down player map))
+       ((= key bearlibterminal-ffi:+tk-right+) (move-right player map))
+       ((= key bearlibterminal-ffi:+tk-left+) (move-left player map))
+       ((= key bearlibterminal-ffi:+tk-w+) (move-up viewport map))
+       ((= key bearlibterminal-ffi:+tk-a+) (move-left viewport map))
+       ((= key bearlibterminal-ffi:+tk-d+) (move-right viewport map))
+       ((= key bearlibterminal-ffi:+tk-s+) (move-down viewport map))
+       ((= key bearlibterminal-ffi:+tk-space+) (update-location viewport map (slot-value viewport 'location) (slot-value player 'location)))))))
 
 (defun main-loop ()
   (loop with player = (make-instance 'player-character)