cb3863ea23c1 default tip
More
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.")))