cb3863ea23c1 default tip

More
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Thu, 22 Apr 2021 00:50:55 -0400
parents 9d304403bb0b
children (none)
branches/tags default tip
files scratch.lisp src/main.lisp

Changes

--- a/scratch.lisp	Wed Apr 21 16:05:17 2021 -0400
+++ b/scratch.lisp	Thu Apr 22 00:50:55 2021 -0400
@@ -55,5 +55,5 @@
 (offer 'tools 'field-guide)
 
 (iterate (for i :in (available-to-buy))
-                          (collect (cons (description i)
-                                         (cons (section i) (key i)))))
+         (collect (cons (description i)
+                        (cons (section i) (key i)))))
--- a/src/main.lisp	Wed Apr 21 16:05:17 2021 -0400
+++ b/src/main.lisp	Thu Apr 22 00:50:55 2021 -0400
@@ -214,7 +214,7 @@
 (defvar *money* 0)
 (defvar *offered* nil)
 (defvar *customer* nil)
-(defparameter *customers-per-second* (float 1/10))
+(defparameter *customers-per-second* (float 1/1))
 
 
 (defun human-money (money)
@@ -249,6 +249,17 @@
           (t (progn (msg "You sell a mushroom.")
                     (sell (random-elt options #'random)))))))
 
+(defun attempt-to-buy (id)
+  (destructuring-bind (section . key) id
+    (let* ((item (inv-ref section key))
+           (price (price item)))
+      (cond ((> price *money*) (msg "You can't afford that."))
+            (t (progn (decf *money* price)
+                      (msg "You buy ~A." (description item))
+                      (alexandria:removef *offered* id :test #'equal)
+                      (unlock 'hire)))))))
+
+
 (defun available-to-buy ()
   (iterate (for (section . key) :in *offered*)
            (collect (inv-ref section key))))
@@ -472,13 +483,15 @@
 
 (defmethod press ((k (eql 'buy)))
   (if *offered*
-    (let ((options (iterate
+    (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)))
+                     (collect (cons s (cons (section i) (key i))))))
+           (chosen (choose "What do you want to buy?" options)))
+      (when chosen
+        (attempt-to-buy chosen)))
     (msg "There's nothing you can buy right now.")))