# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1619026566 14400
# Node ID 60483297353deb3e9b43a8311bd71346c053ce93
# Parent  75152f6efda61596d1cd476d1c668f96f96e1faf
Progress

diff -r 75152f6efda6 -r 60483297353d .lispwords
--- a/.lispwords	Tue Apr 20 18:01:32 2021 -0400
+++ b/.lispwords	Wed Apr 21 13:36:06 2021 -0400
@@ -1,3 +1,4 @@
 (1 stack shelf pile)
 (2 canvas)
 (1 with-chiron-layer)
+(2 with-widget)
diff -r 75152f6efda6 -r 60483297353d scratch.lisp
--- a/scratch.lisp	Tue Apr 20 18:01:32 2021 -0400
+++ b/scratch.lisp	Wed Apr 21 13:36:06 2021 -0400
@@ -38,3 +38,15 @@
                                    (boots:event= option e m))
                                  options :key #'first)))))))
 
+
+(widget-pos 'forage)
+(panel-widgets (current-panel))
+
+(mod -1 6)
+
+(current-panel)
+(focus-dir 0 1)
+
+(focus 'forage)
+(focusedp 'forage)
+(unlockedp 'money)
diff -r 75152f6efda6 -r 60483297353d src/main.lisp
--- a/src/main.lisp	Tue Apr 20 18:01:32 2021 -0400
+++ b/src/main.lisp	Wed Apr 21 13:36:06 2021 -0400
@@ -10,6 +10,9 @@
 (defconstant +reverse+ (boots:attr :fg +black+ :bg +white+))
 (defconstant +selected+ (boots:attr :fg +white+ :bg +dark-purple+ :bold t))
 
+(defconstant +button-default+  (boots:attr :fg +white+ :bg +black+       :bold t))
+(defconstant +button-selected+ (boots:attr :fg +white+ :bg +dark-purple+ :bold t))
+
 
 ;;;; State --------------------------------------------------------------------
 (defvar *event* nil)
@@ -18,14 +21,10 @@
 (defvar *debug* (make-ring-buffer))
 (defvar *pcg* (pcg:make-pcg))
 (defvar *elapsed* nil)
-(defvar *panels* nil)
-(defvar *unlocked* nil)
 (defvar *messages* (make-ring-buffer :size 16))
 (defvar *calories* 0.0)
+(defvar *focused* nil)
 
-;;;; Config -------------------------------------------------------------------
-(defparameter *forage-chance* 0.1)
-(defparameter *calories-per-second* 1.0)
 
 ;;;; Assets -------------------------------------------------------------------
 (defun load-asset (path)
@@ -84,12 +83,6 @@
       (write-line s)))
   (values))
 
-(defun unlock (&rest keys)
-  (apply #'hset-insert! *unlocked* keys))
-
-(defun unlockedp (key)
-  (hset-contains-p *unlocked* key))
-
 (defun msg (string &rest args)
   (rb-push *messages* (apply #'format nil string args)))
 
@@ -106,6 +99,7 @@
 
 (defclass* mushroom (item)
   ((section :initform 'mushrooms)
+   (price :initform 1)
    (calories :initform 100)))
 
 (defclass* tool (item)
@@ -126,15 +120,16 @@
 
 (defun make-mushrooms ()
   (make-items 'mushroom
-              '((chantrelle "Chantrelle mushroom" :calories 60)
-                (matsutake "Matsutake mushroom" :calories 200))))
+              '((chantrelle "Chantrelle mushroom" :calories 60 :price 1)
+                (matsutake "Matsutake mushroom" :calories 200 :price 15))))
+
 
 
 ;;;; Inventory ----------------------------------------------------------------
 (defvar *inventory* nil)
 (defvar *inventory-index* nil)
 
-(defparameter *sections* '(tools mushrooms))
+(defparameter *sections* '(mushrooms tools))
 
 (defun inv-ref (section key)
   ;; should have been a setf expander but time is short
@@ -174,22 +169,51 @@
 
 
 ;;;; Hunger -------------------------------------------------------------------
+(defparameter *calories-per-second* 1.0)
+
+(defun hungryp ()
+  (< *calories* 100.0))
+
+(defun starvingp ()
+  (zerop *calories*))
+
+(defun fullp ()
+  (> *calories* 1000.0))
+
 (defun eat (mushroom)
   (incf *calories* (calories mushroom))
   (inv-dec mushroom))
 
 (defun attempt-to-eat ()
-  (let ((options (inv-section-items 'mushrooms :only-owned t)))
-    (if (null options)
-      nil
-      (progn (msg "You feel hungry.  You eat a mushroom.")
-             (eat (random-elt options #'random))))))
+  (if (fullp)
+    (progn (msg "You're too full to eat any more.")
+           (unlock 'money)
+           (unlock 'sell))
+    (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)))))))
 
 (defun tick/hunger (delta)
   (let ((consumed (* delta *calories-per-second*)))
-    (setf *calories* (max 0.0 (- *calories* consumed)))
-    (when (zerop *calories*)
-      (attempt-to-eat))))
+    (setf *calories* (max 0.0 (- *calories* consumed)))))
+
+
+;;;; Money --------------------------------------------------------------------
+(defvar *money* 0)
+
+(defun sell (mushroom)
+  (incf *money* (price mushroom))
+  (inv-dec mushroom))
+
+(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))))))
+
 
 ;;;; Splash -------------------------------------------------------------------
 (defparameter *ui/splash/bg*
@@ -229,6 +253,8 @@
 
 
 ;;;; Panels -------------------------------------------------------------------
+(defvar *panels* nil)
+
 (defclass* panel ()
   ((draw-function)
    (selected)
@@ -236,39 +262,142 @@
    (ui)))
 
 (defgeneric panel-name (panel))
+(defgeneric panel-widgets (panel))
+
+(defun current-panel ()
+  (find-if #'selected *panels*))
+
+
+;;;; Widgets ------------------------------------------------------------------
+(defvar *unlocked* nil)
+
+
+(defun unlock (&rest keys)
+  (apply #'hset-insert! *unlocked* keys))
+
+(defun unlockedp (key)
+  (hset-contains-p *unlocked* key))
+
+
+(defun widget-pos (key)
+  (let ((widgets (panel-widgets (current-panel))))
+    (destructuring-bind (rows cols) (array-dimensions widgets)
+      (do-range ((r 0 rows)
+                 (c 0 cols))
+        (when (eql key (aref widgets r c))
+          (return-from widget-pos (values r c)))))))
+
+(defun widget-ref (row col)
+  (let ((widgets (panel-widgets (current-panel))))
+    (destructuring-bind (rows cols) (array-dimensions widgets)
+      (aref widgets (mod row rows) (mod col cols)))))
+
+
+(defun focusedp (key)
+  (assert key)
+  (eql key *focused*))
+
+(defun focus (key)
+  (assert key)
+  (setf *focused* key))
+
+(defun focus-dir (dr dc)
+  (multiple-value-bind (r c) (widget-pos *focused*)
+    (iterate
+      (incf r dr)
+      (incf c dc)
+      (for key = (widget-ref r c))
+      (when (and key (unlockedp key))
+        (focus key)
+        (return)))))
+
+
+(defmacro with-widget (key (color) &body body)
+  `(when (unlockedp ',key)
+     (let ((,color (if (focusedp ',key) +button-selected+ +button-default+)))
+       ,@body)))
+
+
+(defgeneric press (widget-key))
 
 
 ;;;; Forest -------------------------------------------------------------------
 (defparameter *ui/forest/forage*
-  (boots:make-canvas :height 1 :margin-bottom 1 :draw 'draw/forest/forage))
+  (boots:make-canvas :height 2 :margin-bottom 1 :draw 'draw/forest/forage))
+
+(defparameter *ui/forest/eat*
+  (boots:make-canvas :height 2 :margin-bottom 1 :draw 'draw/forest/eat))
+
+(defparameter *ui/forest/sell*
+  (boots:make-canvas :height 2 :margin-bottom 1 :draw 'draw/forest/sell))
 
 (defparameter *ui/forest*
   (boots:shelf (:fill-char #\space :fill-attr +default+)
-    *ui/forest/forage*))
+    (boots:stack (:fill-char #\space :fill-attr +default+)
+      *ui/forest/forage*)
+    (boots:stack (:fill-char #\space :fill-attr +default+)
+      *ui/forest/eat*
+      *ui/forest/sell*)))
 
 
 (defclass* forest (panel)
   ((ui :initform *ui/forest*)
    (key :initform 'forest)))
 
-(defmethod panel-name ((p forest))
-  "Forest")
+
+(defmethod panel-name ((p forest)) "Forest")
+(defmethod panel-widgets ((p forest)) #2A((forage eat)
+                                          (nil sell)))
+
 
 (defun draw/forest/forage (pad)
-  (when (unlockedp 'forage)
-    (boots:draw pad 0 0 "[Forage for mushrooms]" +default+)))
+  (with-widget forage (c)
+    (boots:draw pad 0 0 "The forest is peaceful." +default+)
+    (boots:draw pad 0 1 "[Forage for mushrooms]" c)))
+
+(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"))
+                          ".")
+                +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+)
+    (boots:draw pad 0 1 "[Sell a mushroom]" c)))
+
 
 (chancery:define-rule (random-forage :distribution :weighted)
   (1 'chantrelle)
   (1 'matsutake))
 
 
-(defun press/forage ()
-  (if (randomp *forage-chance*)
+(defparameter *base-forage-chance* 0.1)
+
+(defun forage-chance ()
+  (* *base-forage-chance*
+     (cond ((fullp) 1.1)
+           ((hungryp) 2.0)
+           ((starvingp) 0.5)
+           (t 1.0))))
+
+(defmethod press ((k (eql 'forage)))
+  (if (randomp (forage-chance))
     (progn (msg "You found a mushroom.")
-           (inv-inc 'mushrooms (random-forage)))
+           (inv-inc 'mushrooms (random-forage))
+           (unlock 'eat))
     (msg "You don't find anything.")))
 
+(defmethod press ((k (eql 'eat)))
+  (attempt-to-eat))
+
+(defmethod press ((k (eql 'sell)))
+  (attempt-to-sell))
+
 
 ;;;; Game ---------------------------------------------------------------------
 (defparameter *ui/game/top-bar*
@@ -315,16 +444,20 @@
               (format nil "~Ds" (truncate *elapsed* internal-time-units-per-second))
               +default+))
 
+
 (defun draw/game/messages (pad)
   ;; todo make reverse iteration stuff for ring buffers
   (iterate (for i :from -1 :downto (- (rb-count *messages*)))
            (for y :from 0)
     (boots:draw pad 0 y (rb-ref *messages* i) +default+)))
 
-(defun draw/game/inventory (pad)
-  (draw-center pad 0 "INVENTORY" +bold+)
+(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))
   (iterate
-    (with y = 2)
     (with h = (boots:height pad))
     (while (< y h))
     (for sy = y)
@@ -362,8 +495,12 @@
       (boots:redraw)
       (event-case (boots:read-event-no-hang)
         (nil (boots:wait 1/30))
-        (#\newline (press/forage))
+        (#\newline (press *focused*))
         (#\tab (msg "TODO"))
+        (:left  (focus-dir  0 -1))
+        (:right (focus-dir  0  1))
+        (:up    (focus-dir -1  0))
+        (:down  (focus-dir  1  0))
         (t nil)))))
 
 
@@ -415,7 +552,9 @@
   (setf *seed* (cl:random (expt 2 60) (cl:make-random-state))
         *pcg* (pcg:make-pcg :seed *seed*)
         *elapsed* 0
-        *calories* (* 1.0  10)
+        *focused* 'forage
+        *money* 0
+        *calories* (* 1.0 10)
         *panels* (vector (make-instance 'forest :selected t))
         *unlocked* (make-hash-set :initial-contents '(forest forage)))
   (values))