9d304403bb0b

More
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Wed, 21 Apr 2021 16:05:17 -0400
parents 2e93a4fe55f1
children cb3863ea23c1
branches/tags (none)
files scratch.lisp src/main.lisp

Changes

--- a/scratch.lisp	Wed Apr 21 14:10:23 2021 -0400
+++ b/scratch.lisp	Wed Apr 21 16:05:17 2021 -0400
@@ -50,3 +50,10 @@
 (focus 'forage)
 (focusedp 'forage)
 (unlockedp 'money)
+
+(values *calories*)
+(offer 'tools 'field-guide)
+
+(iterate (for i :in (available-to-buy))
+                          (collect (cons (description i)
+                                         (cons (section i) (key i)))))
--- a/src/main.lisp	Wed Apr 21 14:10:23 2021 -0400
+++ b/src/main.lisp	Wed Apr 21 16:05:17 2021 -0400
@@ -22,7 +22,6 @@
 (defvar *pcg* (pcg:make-pcg))
 (defvar *elapsed* nil)
 (defvar *messages* (make-ring-buffer :size 16))
-(defvar *calories* 0.0)
 (defvar *focused* nil)
 
 
@@ -97,11 +96,11 @@
   (section
    key
    description
+   (price :initform 0)
    (owned :initform 0)))
 
 (defclass* mushroom (item)
   ((section :initform 'mushrooms)
-   (price :initform 1)
    (calories :initform 100)))
 
 (defclass* tool (item)
@@ -119,12 +118,12 @@
 (defun make-tools ()
   (make-items 'tool '((trowel "Small trowel" :owned 1)
                       (bucket "Sturdy bucket" :owned 1)
-                      (field-guide "Field guide"))))
+                      (field-guide "Field guide" :price 1999))))
 
 (defun make-mushrooms ()
   (make-items 'mushroom
-              '((chantrelle "Chantrelle mushroom" :calories 60 :price 1)
-                (matsutake "Matsutake mushroom" :calories 200 :price 15))))
+              '((chantrelle "Chantrelle mushroom" :calories 60 :price 15)
+                (matsutake "Matsutake mushroom" :calories 200 :price 1000))))
 
 
 
@@ -172,19 +171,25 @@
 
 
 ;;;; Hunger -------------------------------------------------------------------
+(defvar *calories* 0.0)
+
 (defparameter *calories-per-second* 1.0)
+(defparameter *calories/hungry* 100.0)
+(defparameter *calories/full* 600.0)
+(defparameter *calories/max* 1000.0)
 
 (defun hungryp ()
-  (< *calories* 100.0))
+  (< *calories* *calories/hungry*))
 
 (defun starvingp ()
   (zerop *calories*))
 
 (defun fullp ()
-  (> *calories* 1000.0))
+  (> *calories* *calories/full*))
 
 (defun eat (mushroom)
   (incf *calories* (calories mushroom))
+  (clampf *calories* 0 *calories/max*)
   (inv-dec mushroom))
 
 (defun attempt-to-eat ()
@@ -197,28 +202,76 @@
                (eat (random-elt options #'random))
                (when (fullp)
                  (unlock 'money)
-                 (unlock 'sell)))))))
+                 (when (unlock 'sell)
+                   (ensure-customer))))))))
 
 (defun tick/hunger (delta)
-  (let ((consumed (* delta *calories-per-second*)))
-    (setf *calories* (max 0.0 (- *calories* consumed)))))
+  (decf *calories* (* delta *calories-per-second*))
+  (clampf *calories* 0 *calories/max*))
 
 
 ;;;; Money --------------------------------------------------------------------
 (defvar *money* 0)
+(defvar *offered* nil)
+(defvar *customer* nil)
+(defparameter *customers-per-second* (float 1/10))
 
 
+(defun human-money (money)
+  (multiple-value-bind (dollars cents) (truncate money 100)
+    (format nil "$~D.~2,'0D" dollars cents)))
+
+(defun offer (section key)
+  (push (cons section key) *offered*))
+
+(chancery:define-string random-customer
+  "A man"
+  "A woman"
+  "A mycologist"
+  "A chef")
+
+(defun ensure-customer ()
+  (when (null *customer*)
+    (setf *customer* (random-customer))
+    t))
+
 (defun sell (mushroom)
   (incf *money* (price mushroom))
   (inv-dec mushroom)
-  (unlock 'buy))
+  (setf *customer* nil)
+  (when (unlock 'buy)
+    (offer 'tools 'field-guide)))
 
 (defun attempt-to-sell ()
   (let ((options (inv-section-items 'mushrooms :only-owned t)))
-    (if (null options)
-      (msg "You don't have any mushrooms to sell.")
-      (progn (msg "You sell a mushroom.")
-             (sell (random-elt options #'random))))))
+    (cond ((null options) (msg "You don't have any mushrooms to sell."))
+          ((null *customer*) (msg "No one wants to buy your mushrooms."))
+          (t (progn (msg "You sell a mushroom.")
+                    (sell (random-elt options #'random)))))))
+
+(defun available-to-buy ()
+  (iterate (for (section . key) :in *offered*)
+           (collect (inv-ref section key))))
+
+(defun tick/customers (delta)
+  (when (randomp (* *customers-per-second* delta))
+    (when (ensure-customer)
+      (msg "~A wanders by and wants to buy a mushroom." *customer*))))
+
+
+;;;; Ambience -----------------------------------------------------------------
+(defparameter *ambient-events-per-second* (float 1/60))
+
+(chancery:define-string random-ambient
+  "You hear the patter of rain on the forest canopy."
+  "A bird calls in the woods."
+  "The smell of loam fills your nostrils.")
+
+(defun tick/ambience (delta)
+  (when (randomp (* *ambient-events-per-second* delta))
+    (if (or (hungryp) (starvingp))
+      (msg "Your stomach rumbles.")
+      (msg (random-ambient)))))
 
 
 ;;;; Splash -------------------------------------------------------------------
@@ -277,8 +330,9 @@
 (defvar *unlocked* nil)
 
 
-(defun unlock (&rest keys)
-  (apply #'hset-insert! *unlocked* keys))
+(defun unlock (key)
+  (prog1 (not (hset-contains-p *unlocked* key))
+    (hset-insert! *unlocked* key)))
 
 (defun unlockedp (key)
   (hset-contains-p *unlocked* key))
@@ -366,22 +420,26 @@
 
 (defun draw/forest/eat (pad)
   (with-widget eat (c)
-    (boots:draw pad 0 0 `("You feel " ,(cond ((fullp) "full")
-                                            ((hungryp) "hungry")
-                                            ((starvingp) "starving")
-                                            (t "content"))
+    (boots:draw pad 0 0 `("You " ,(cond ((fullp) "feel full")
+                                        ((starvingp) "are starving")
+                                        ((hungryp) "are hungry")
+                                        (t "feel content"))
                           ".")
                 +default+)
     (boots:draw pad 0 1 "[Eat a mushroom]" c)))
 
 (defun draw/forest/sell (pad)
   (with-widget sell (c)
-    (boots:draw pad 0 0 "Other people want mushrooms too." +default+)
+    (if *customer*
+      (boots:draw pad 0 0 (format nil "~A wants to buy a mushroom." *customer*) +default+)
+      (boots:draw pad 0 0 "No one wants to buy mushrooms." +default+))
     (boots:draw pad 0 1 "[Sell a mushroom]" c)))
 
 (defun draw/forest/buy (pad)
   (with-widget buy (c)
-    (boots:draw pad 0 0 "Spend some money?" +default+)
+    (if *offered*
+      (boots:draw pad 0 0 "Time for a shopping trip?" +default+)
+      (boots:draw pad 0 0 "Nothing's for sale right now." +default+))
     (boots:draw pad 0 1 "[Buy something]" c)))
 
 
@@ -413,9 +471,15 @@
   (attempt-to-sell))
 
 (defmethod press ((k (eql 'buy)))
-  (msg (choose "What do you want to buy?"
-               '(("Foo" . "foo selected")
-                 ("Bar" . "bar selected")))))
+  (if *offered*
+    (let ((options (iterate
+                     (for i :in (available-to-buy))
+                     (for s = (format nil "~A - ~A"
+                                      (human-money (price i))
+                                      (description i)))
+                     (collect (cons s (cons (section i) (key i)))))))
+      (msg (choose "What do you want to buy?" options)))
+    (msg "There's nothing you can buy right now.")))
 
 
 ;;;; Game ---------------------------------------------------------------------
@@ -457,6 +521,8 @@
       *ui/game/messages*
       *ui/game/bottom-bar*)))
 
+(defvar *layer-container* *ui/game*)
+
 
 (defun draw/game/bottom-bar (pad)
   (draw-right pad (1- (boots:width pad)) 0 "[?] Help [ESC] Pause/Quit" +default+))
@@ -481,7 +547,7 @@
 
 (defun draw/game/inventory (pad &aux (y 0))
   (when (unlockedp 'money)
-    (boots:draw pad 0 y (format nil "$~D" *money*) +default+)
+    (boots:draw pad 0 y (human-money *money*) +default+)
     (incf y 2))
   (iterate
     (with h = (boots:height pad))
@@ -502,20 +568,28 @@
       (incf y 2))))
 
 
+
 (defmacro with-layer (ui &body body)
-  `(progn (push ,ui (boots:children *ui/game*))
+  `(progn (push ,ui (boots:children *layer-container*))
      (unwind-protect (progn ,@body)
-       (pop (boots:children *ui/game*)))))
+       (pop (boots:children *layer-container*)))))
 
 (defun tick (delta)
-  (tick/hunger delta))
+  (tick/hunger delta)
+  (tick/ambience delta)
+  (tick/customers delta))
+
+(defmacro ticking-loop (&body body)
+  (alexandria:with-gensyms (delta)
+    `(iterate
+       (timing real-time :per-iteration-into ,delta)
+       (incf *elapsed* ,delta)
+       (tick (/ (float ,delta 1.0d0) internal-time-units-per-second))
+       (progn ,@body))))
 
 (defun game ()
   (with-ui *ui/game*
-    (iterate
-      (timing real-time :per-iteration-into delta)
-      (incf *elapsed* delta)
-      (tick (/ (float delta 1.0d0) internal-time-units-per-second))
+    (ticking-loop
       (setf (first (boots:children *ui/game/panel*))
             (ui (find-if #'selected *panels*)))
       (boots:redraw)
@@ -546,14 +620,16 @@
                          (for y :from 2)
                          (for c = (if (= i selected) +button-selected+ +button-default+))
                          (boots:draw pad 0 y option c)))
-    (loop (setf selected (mod selected n))
-          (boots:redraw)
-          (boots:event-case (boots:read-event)
-            (#\newline (return (cdr (elt options selected))))
-            (#\esc (return nil))
-            (:up   (incf selected))
-            (:down (decf selected))
-            (t nil)))))
+    (ticking-loop
+      (setf selected (mod selected n))
+      (boots:redraw)
+      (boots:event-case (boots:read-event-no-hang)
+        (nil nil)
+        (#\newline (return-from choose (cdr (elt options selected))))
+        (#\esc (return-from choose nil))
+        (:up   (incf selected))
+        (:down (decf selected))
+        (t nil)))))
 
 
 ;;;; Pause --------------------------------------------------------------------
@@ -606,7 +682,9 @@
         *elapsed* 0
         *focused* 'forage
         *money* 0
-        *calories* (* 1.0 10)
+        *offered* nil
+        *calories* (* 1.0 60)
+        *layer-container* *ui/game*
         *panels* (vector (make-instance 'forest :selected t))
         *unlocked* (make-hash-set :initial-contents '(forest forage)))
   (values))