Support for the passage of time

flora-search-aurora.lisp

@@ -40,16 +40,6 @@
 (in-package :flora-search-aurora)
 
 
-(defmacro aget-item (map item)
-  `(assoc-utils:aget (gethash :items ,map) ,item))
-
-
-(defmacro getf-act (map act)
-  `(getf (gethash :acts ,map) ,act))
-
-
-(defmacro getf-know (map idea)
-  `(getf (gethash :knows ,map) ,idea))
 
 
 
@@ -114,9 +104,7 @@ Should be the `interact` function for takeable items."
 ;;; Childhood friend (Sasha) arc
 ;;; ———————————————————————————————————
 (defun childhood-friend-greetings (map)
-  (if (getf-act map :sasha-greetings)
+  (…:incf-0 (getf-act map :sasha-greetings))
-    (incf (getf-act map :sasha-greetings))
-    (setf (getf-act map :sasha-greetings) 0))
   (let ((sasha "childhood-friend"))
     (case (getf-act map :sasha-greetings)
        (0
@@ -268,9 +256,7 @@ Should be the `interact` function for takeable items."
 ;;; Destitute Gambler arc
 ;;; ———————————————————————————————————
 (defun bad-gambler-greetings (map)
-  (if (getf-act map :gambler-greetings)
+  (…:incf-0 (getf-act map :gambler-greetings))
-    (incf (getf-act map :gambler-greetings))
-    (setf (getf-act map :gambler-greetings) 0))
   (let ((gambler "bad-gambler"))
     (case (getf-act map :gambler-greetings)
        (0

overworld.lisp

@@ -25,6 +25,7 @@
            #:merge-maps
            #:world-coords->screen-coords
            #:getf-entity #:getf-entity-data #:removef-entity
+           #:aget-item #:getf-act #:getf-know
            #:move-entity-to #:move-entity
            :left :right
            :player))
@@ -77,6 +78,31 @@ stomache and PULL HARD, show NO REMORSE. RAAAAAA 🗡🩸"
           (gethash :entities map)))
 
 
+(defmacro aget-item (map item)
+  "Get an item from the MAP’s :ITEMS alist. That is, an item in user’s inventory.
+Members of :ITEMS will not be persistent beween play-throughs; the user has to
+get everything again."
+  `(assoc-utils:aget (gethash :items ,map) ,item))
+
+
+(defmacro getf-act (map act)
+  "Get an ACT from the MAP’s :ACTS plist. That is, some marker indicating that
+the user has done something. Just like :ITEMS, these are not persistent through
+replays of the game."
+  `(getf (gethash :acts ,map) ,act))
+
+
+(defmacro getf-know (map idea)
+  "Get an item from the MAP’s :KNOWS plist. That is, some marker indicating that
+the user knows something. Unlike :ITEMS and :ACTS, these _are_ persistent through
+replays of the game."
+  `(getf (gethash :knows ,map) ,idea))
+
+
+
+;;; ———————————————————————————————————
+;;; Item searching/testing
+;;; ———————————————————————————————————
 (defun entities-near-coords (coords radius entities &key (x-radius radius) (y-radius radius))
   "Return a list of entity-plists that are near the given coordinates within the given RADIUS."
   (remove-if-not
@@ -92,7 +118,7 @@ stomache and PULL HARD, show NO REMORSE. RAAAAAA 🗡🩸"
 
 
 (defun entities-near-entity (entity entities)
-  "Return a list of entities near the given entity — that is, within touching-distance."
+  "Return a new list of entities near the given ENTITY — that is, within touching-distance."
   (remove-if
    (lambda (test-entity)
      (…:plist= (cdr entity)
@@ -104,7 +130,7 @@ stomache and PULL HARD, show NO REMORSE. RAAAAAA 🗡🩸"
 
 
 (defun cell-at-world-coords-p (map-chunks coords)
-  "Return whether or not there is a cell at the given coordinates."
+  "Return whether or not there is a cell at the given COORDS."
   (let ((chunk (world-coords-chunk coords)))
     (member 't (cdr (assoc chunk map-chunks))
             :test (lambda (ignored cell)
@@ -112,29 +138,56 @@ stomache and PULL HARD, show NO REMORSE. RAAAAAA 🗡🩸"
 
 
 (defun walkable-tile-p (map x y)
-  "Return whether or not the given coordinates on the map are traversable for an entity."
+  "Return whether or not the given coordinates on the MAP are traversable for an entity."
   (not (cell-at-world-coords-p (gethash :bump-map map)
                                (list :x x :y y))))
 
 
 (defun trigger-at-coords (map world-coords)
+  "Return a “Trigger”-rectangle from MAP that’d be triggered at the given coords."
   (let ((chunk (world-coords-chunk world-coords)))
     (loop for trigger in (cdr (assoc chunk (gethash :triggers map)))
-           do (when (within-rectangle world-coords
+          do (when (within-rectangle world-coords
-                                       (getf trigger :coords) (getf trigger :bottom-coords))
+                                     (getf trigger :coords) (getf trigger :bottom-coords))
-                (return trigger)))))
+               (return trigger)))))
 
 
 
 ;;; ———————————————————————————————————
 ;;; Overworld logic
 ;;; ———————————————————————————————————
-(defun overworld-state-update (map)
+(defun overworld-state-update (map Δt)
   "Do nothing, lol. Core part of OVERWORLD-STATE.
 Returns parameters to be used in the next invocation of OVERWORLD-STATE."
+  (process-overworld-time map Δt)
   (process-overworld-input map))
 
 
+(defun seconds->game-datetime (seconds &key (game-day-length 240))
+  "Convert real-world SECONDS into a datetime plist, calculating with
+GAME-DAY-LENGTH as as the seconds-per-day.
+Returns a plist of properties :DAY, :HOUR, and :MINUTE, all numbers."
+  (let* ((game-days (floor (/ seconds game-day-length))) ;; Days passed in game-time
+         (seconds (floor (- seconds (* game-days game-day-length)))) ;; Keep hour below 24!
+         (real-day-length 1440)) ;; You know what I mean <w<
+    (multiple-value-bind (hour minutes-fraction)
+        (floor (/ (* seconds (/ real-day-length game-day-length))
+                  60))
+      (list :day game-days :hour hour
+            :minute (floor (* 60 minutes-fraction))))))
+
+
+(defun process-overworld-time (map Δt)
+  "Do nothing, lol. Core part of OVERWORLD-STATE.
+Returns parameters to be used in the next invocation of OVERWORLD-STATE."
+  (let* ((time (…:incf-0 (gethash :seconds map) Δt))
+         (game-datetime (seconds->game-datetime time)))
+    ;; Go through the day-update procedures!
+    (when (not (eq (getf game-datetime :day)
+                   (gethash :day map)))
+        (setf (gethash :day map) (getf game-datetime :day)))))
+
+
 (defun process-overworld-input (map)
   "Get and process any keyboard input, modifying the map or entities as necessary."
   (if (listen)
@@ -175,7 +228,6 @@ Returns parameters to be used in the next invocation of OVERWORLD-STATE."
         (list :map map))))
 
 
-
 (defun move-entity (map entity-id &key (Δx 0) (Δy 0))
   "Move an entity relative to its current position."
   (when (< Δx 0)
@@ -217,9 +269,15 @@ A core part of OVERWORLD-STATE."
   (let* ((chunk (world-coords-chunk (getf-entity-data map 'player :coords))))
     (matrix-write-tiles matrix (gethash :tiles map) chunk)
     (matrix-write-entities matrix map chunk)
+    (when (gethash :seconds map)
+      (matrix-write-datetime matrix (seconds->game-datetime (gethash :seconds map))))
     (matrix-write-tiles matrix (gethash :top-tiles map) chunk)))
 
 
+
+;;; ———————————————————————————————————
+;;; Overworld-drawing: Map-tiles
+;;; ———————————————————————————————————
 (defun matrix-write-tiles (matrix tiles chunk
                            &key (chunk-width 72) (chunk-height 20))
   "Draw a map’s specific chunk (by its ID) to the matrix."
@@ -300,17 +358,37 @@ alist containing a character (:CHAR) and :X & :Y coordinates."
            (ignore-errors (setf (aref matrix y (+ x 1)) #\|))))))
 
 
+
+;;; ———————————————————————————————————
+;;; Overworld-drawing: The date
+;;; ———————————————————————————————————
+(defun game-datetime->string (date-plist &optional (year 2006))
+  (format nil
+          (…:getf-lang '(:en "~A ~A ~A ~2,'0d:~2,'0d"
+                         :eo "~A ~A ~Aa ~2,'0d:~2,'0d"))
+          year
+          (…:getf-lang '(:en "Jun" :eo "Jun"))
+          (+ (getf date-plist :day) 3)
+          (getf date-plist :hour)
+          (getf date-plist :minute)))
+
+
+(defun matrix-write-datetime (matrix datetime)
+  (let ((string (game-datetime->string datetime)))
+    (📋:render-line matrix string (- 71 (length string)) 19)))
+
+
 
 ;;; ———————————————————————————————————
 ;;; Overworld loop
 ;;; ———————————————————————————————————
 (defun overworld-state
-    (matrix &key map)
+    (matrix &key map (Δt .02))
   "Render the given map to the matrix and take user-input — for one frame.
 A state-function for use with STATE-LOOP."
-  (sleep .02)
+  (sleep Δt)
   (overworld-state-draw matrix map)
-  (overworld-state-update map))
+  (overworld-state-update map Δt))
 
 
 (defun make-overworld-state (map)
@@ -320,11 +398,14 @@ A state-function for use with STATE-LOOP."
            (list matrix :map map))))
 
 
-
 (defun merge-maps (map-a map-b)
   "Copy data that should be persistent between maps from map-a to map-b."
-  (setf (gethash :acts map-b) (gethash :acts map-a))
+  ;; Copy over important game-data from map-a.
-  (setf (gethash :knows map-b) (gethash :knows map-a))
+  (mapcar
+   (lambda (map-key)
+     (setf (gethash map-key map-b) (gethash map-key map-a)))
+   '(:acts :knows :items :seconds :day))
+  ;; Copy specific bits of player data from map-a’s :ENTITIES.
   (mapcar
    (lambda (player-key)
      (setf (getf-entity-data map-b 'player player-key)

util.lisp

@@ -22,6 +22,7 @@
   (:use :cl :assoc-utils)
   (:export #:split-string-by-length
            #:plist=
+           #:incf-0
            #:at-least #:at-most
            #:system-language #:langcode->keysym #:getf-lang))
 
@@ -58,6 +59,13 @@ Uses the keys of plist a."
           finally (return 't))))
 
 
+(defmacro incf-0 (place &optional (Δ 1))
+  "INCF the given PLACE, if it’s a number. If not a number, then set it to zero."
+  `(if (numberp ,place)
+       (incf ,place ,Δ)
+       (setf ,place 0)))
+
+
 (defun at-least (minimum num)
   "This function returns at least every hope and dream you've ever had, and at
 maximum returns your more pitiful of moments."