# HG changeset patch # User Steve Losh # Date 1619035517 14400 # Node ID 9d304403bb0b72ecd73786f5949136638a7a8a07 # Parent 2e93a4fe55f14ad836c829c72d5cc9a4a9b85747 More diff -r 2e93a4fe55f1 -r 9d304403bb0b scratch.lisp --- 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))))) diff -r 2e93a4fe55f1 -r 9d304403bb0b src/main.lisp --- 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))