--- a/.lispwords Wed Apr 21 13:36:06 2021 -0400
+++ b/.lispwords Wed Apr 21 14:10:23 2021 -0400
@@ -2,3 +2,4 @@
(2 canvas)
(1 with-chiron-layer)
(2 with-widget)
+(1 with-layer)
--- a/assets/help.txt Wed Apr 21 13:36:06 2021 -0400
+++ b/assets/help.txt Wed Apr 21 14:10:23 2021 -0400
@@ -1,2 +1,4 @@
-[esc] Pause (with options to resume/quit)
-[tab] Switch between panels.
+[arrows] Switch actions.
+[enter] Perform action.
+[tab] Switch panels.
+[esc] Pause (with options to resume/quit).
--- a/src/main.lisp Wed Apr 21 13:36:06 2021 -0400
+++ b/src/main.lisp Wed Apr 21 14:10:23 2021 -0400
@@ -84,7 +84,9 @@
(values))
(defun msg (string &rest args)
- (rb-push *messages* (apply #'format nil string args)))
+ (rb-push *messages* (if (null args)
+ (aesthetic-string string)
+ (apply #'format nil string args))))
;;;; Items --------------------------------------------------------------------
@@ -116,7 +118,8 @@
(defun make-tools ()
(make-items 'tool '((trowel "Small trowel" :owned 1)
- (bucket "Sturdy bucket" :owned 1))))
+ (bucket "Sturdy bucket" :owned 1)
+ (field-guide "Field guide"))))
(defun make-mushrooms ()
(make-items 'mushroom
@@ -186,14 +189,15 @@
(defun attempt-to-eat ()
(if (fullp)
- (progn (msg "You're too full to eat any more.")
- (unlock 'money)
- (unlock 'sell))
+ (msg "You're too full to eat any more.")
(let ((options (inv-section-items 'mushrooms :only-owned t)))
(if (null options)
(msg "You don't have any mushrooms to eat.")
(progn (msg "You eat a mushroom.")
- (eat (random-elt options #'random)))))))
+ (eat (random-elt options #'random))
+ (when (fullp)
+ (unlock 'money)
+ (unlock 'sell)))))))
(defun tick/hunger (delta)
(let ((consumed (* delta *calories-per-second*)))
@@ -203,9 +207,11 @@
;;;; Money --------------------------------------------------------------------
(defvar *money* 0)
+
(defun sell (mushroom)
(incf *money* (price mushroom))
- (inv-dec mushroom))
+ (inv-dec mushroom)
+ (unlock 'buy))
(defun attempt-to-sell ()
(let ((options (inv-section-items 'mushrooms :only-owned t)))
@@ -245,10 +251,9 @@
(boots:attr :fg +dark-purple+)))))
(defun splash ()
- (with-ooc-colors
- (with-ui *ui/splash*
- (boots:redraw)
- (press-key #\space)))
+ (with-ui *ui/splash*
+ (boots:redraw)
+ (press-key #\space))
(game))
@@ -331,10 +336,14 @@
(defparameter *ui/forest/sell*
(boots:make-canvas :height 2 :margin-bottom 1 :draw 'draw/forest/sell))
+(defparameter *ui/forest/buy*
+ (boots:make-canvas :height 2 :margin-bottom 1 :draw 'draw/forest/buy))
+
(defparameter *ui/forest*
(boots:shelf (:fill-char #\space :fill-attr +default+)
(boots:stack (:fill-char #\space :fill-attr +default+)
- *ui/forest/forage*)
+ *ui/forest/forage*
+ *ui/forest/buy*)
(boots:stack (:fill-char #\space :fill-attr +default+)
*ui/forest/eat*
*ui/forest/sell*)))
@@ -347,7 +356,7 @@
(defmethod panel-name ((p forest)) "Forest")
(defmethod panel-widgets ((p forest)) #2A((forage eat)
- (nil sell)))
+ (buy sell)))
(defun draw/forest/forage (pad)
@@ -370,6 +379,11 @@
(boots:draw pad 0 0 "Other people want mushrooms too." +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+)
+ (boots:draw pad 0 1 "[Buy something]" c)))
+
(chancery:define-rule (random-forage :distribution :weighted)
(1 'chantrelle)
@@ -398,6 +412,11 @@
(defmethod press ((k (eql 'sell)))
(attempt-to-sell))
+(defmethod press ((k (eql 'buy)))
+ (msg (choose "What do you want to buy?"
+ '(("Foo" . "foo selected")
+ ("Bar" . "bar selected")))))
+
;;;; Game ---------------------------------------------------------------------
(defparameter *ui/game/top-bar*
@@ -409,6 +428,11 @@
:fill-char #\space :fill-attr +default+
:draw 'draw/game/top-bar/time)))
+(defparameter *ui/game/bottom-bar*
+ (boots:make-canvas :height 1 :border-top t
+ :fill-char #\space :fill-attr +default+
+ :draw 'draw/game/bottom-bar))
+
(defparameter *ui/game/messages*
(boots:make-canvas :height 8 :border-top t
:fill-char #\space :fill-attr +default+
@@ -430,9 +454,13 @@
(boots:shelf ()
*ui/game/panel*
*ui/game/inventory*)
- *ui/game/messages*)))
+ *ui/game/messages*
+ *ui/game/bottom-bar*)))
+(defun draw/game/bottom-bar (pad)
+ (draw-right pad (1- (boots:width pad)) 0 "[?] Help [ESC] Pause/Quit" +default+))
+
(defun draw/game/top-bar/panels (pad)
(boots:draw pad 0 0
(iterate (for panel :in-vector *panels*)
@@ -452,8 +480,6 @@
(boots:draw pad 0 y (rb-ref *messages* i) +default+)))
(defun draw/game/inventory (pad &aux (y 0))
- (draw-center pad y "INVENTORY" +bold+)
- (incf y 2)
(when (unlockedp 'money)
(boots:draw pad 0 y (format nil "$~D" *money*) +default+)
(incf y 2))
@@ -504,6 +530,32 @@
(t nil)))))
+;;;; Chooser Box --------------------------------------------------------------
+(defun choose (heading options &aux (selected 0) (n (length options)))
+ ; options: (option . result)
+ (with-layer (boots:canvas (:fill-char #\space :fill-attr +default+
+ :margin t :border t
+ :height (+ 2 n)
+ :width (reduce #'max options
+ :key (alexandria:compose #'length #'car)
+ :initial-value (length heading)))
+ (pad)
+ (boots:draw pad 0 0 heading +default+)
+ (iterate (for (option . nil) :in options)
+ (for i :from 0)
+ (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)))))
+
+
;;;; Pause --------------------------------------------------------------------
(defparameter *ui/pause*
(boots:make-canvas :width 30 :height 4 :border t :margin t
@@ -511,9 +563,9 @@
:draw 'draw/pause))
(defun draw/pause (pad)
- (boots:draw pad 0 0 "Paused" +ooc+)
- (boots:draw pad 0 2 "[R]esume" +ooc+)
- (boots:draw pad 0 3 "[Q]uit Game" +ooc+))
+ (draw-center pad 0 "PAUSE" +bold+)
+ (boots:draw pad 0 2 "[R]esume" +default+)
+ (boots:draw pad 0 3 "[Q]uit Game" +default+))
(defun pause ()
(with-ui *ui/pause*
@@ -527,13 +579,13 @@
;;;; Help --------------------------------------------------------------------
(defparameter *ui/help*
- (boots:make-canvas :width 50 :height (+ 3 (length *asset/help*))
+ (boots:make-canvas :width 50 :height (+ 2 (length *asset/help*))
:border t :margin t
:fill-char #\space :fill-attr +default+
:draw 'draw/help))
(defun draw/help (pad)
- (boots:draw pad 0 0 "HELP" +default+)
+ (draw-center pad 0 "HELP" +bold+)
(iterate (for y :from 2)
(for line :in *asset/help*)
(boots:draw pad 0 y line +default+)))
@@ -564,9 +616,8 @@
(boots/terminals/ansi:with-ansi-terminal (terminal :truecolor t)
(boots:with-screen (boots:*screen* terminal)
(boots:with-light-borders
- (with-in-game-colors
- (catch 'quit
- (splash)))))))
+ (catch 'quit
+ (splash))))))
(defun toplevel ()