--- 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)
--- 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)
--- 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))