# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1483875077 0
# Node ID bf74ba7cd2b771edc5ed7d56d0634cbe403a2d5a
# Parent  f377744f622cbe957379508c14a9059f589bfd88
Add menu, dropping

diff -r f377744f622c -r bf74ba7cd2b7 .lispwords
--- a/.lispwords	Sun Jan 08 11:12:19 2017 +0000
+++ b/.lispwords	Sun Jan 08 11:31:17 2017 +0000
@@ -1,2 +1,2 @@
-(1 with-panel-and-window with-panels-and-windows)
+(1 with-panel-and-window with-panels-and-windows with-dims)
 (1 create-entity)
diff -r f377744f622c -r bf74ba7cd2b7 src/entities/clothing.lisp
--- a/src/entities/clothing.lisp	Sun Jan 08 11:12:19 2017 +0000
+++ b/src/entities/clothing.lisp	Sun Jan 08 11:31:17 2017 +0000
@@ -49,6 +49,6 @@
     :coords/x x
     :coords/y y
     :visible/glyph "&"
-    :visible/color ap::+yellow-black+
+    :visible/color ap::+black-white+
     :holdable/description (random-clothing-description)))
 
diff -r f377744f622c -r bf74ba7cd2b7 src/entities/player.lisp
--- a/src/entities/player.lisp	Sun Jan 08 11:12:19 2017 +0000
+++ b/src/entities/player.lisp	Sun Jan 08 11:31:17 2017 +0000
@@ -55,7 +55,7 @@
   (push entity (player/inventory player)))
 
 (defun player-drop (player entity)
-  (removef entity (player/inventory player))
+  (removef (player/inventory player) entity)
   (setf (coords/x entity) (coords/x player)
         (coords/y entity) (coords/y player))
   (coords-insert-entity entity))
diff -r f377744f622c -r bf74ba7cd2b7 src/main.lisp
--- a/src/main.lisp	Sun Jan 08 11:12:19 2017 +0000
+++ b/src/main.lisp	Sun Jan 08 11:31:17 2017 +0000
@@ -267,6 +267,40 @@
         (iterate (until (eql #\space (charms:get-char win))))))))
 
 
+;;;; Selection Menu -----------------------------------------------------------
+(defun key->index (key)
+  (- (char-code key) (char-code #\a)))
+
+(defun index->key (index)
+  (code-char (+ (char-code #\a) index)))
+
+(defun choose (window items)
+  (let ((choice (key->index (charms:get-char window))))
+    (if (in-range-p 0 choice (length items))
+      (elt items choice)
+      nil)))
+
+(defun menu (prompt items description-function)
+  (let ((descriptions (mapcar description-function items)))
+    (with-dims
+        ((+ 3 (apply #'max (length prompt) (mapcar #'length descriptions)) 4)
+         (+ 3 (length items) 2))
+      (with-panel-and-window
+          (pan win *width* *height*
+               (center *width* *screen-width*)
+               (center *height* *screen-height*))
+        (charms:clear-window win)
+        (border win)
+        (write-string-left win prompt 1 1)
+        (iterate (for desc :in descriptions)
+                 (for y :from 3)
+                 (for i :from 0)
+                 (write-string-left win (format nil "~A - ~A" (index->key i) desc)
+                                    1 y))
+        (redraw)
+        (choose win items)))))
+
+
 ;;;; World Map ----------------------------------------------------------------
 (defun terrain-char (height)
   (cond ((< height -0.20) (values #\~ +blue-black+)) ; deep water
@@ -320,7 +354,7 @@
             (for y :from 1)
             (write-string-left window
                                (format nil "  ~A" (holdable/description item))
-                               0 1)))))))
+                               0 y)))))))
 
 (defun render-map (window)
   (iterate
@@ -385,14 +419,28 @@
            (when (player-inventory-full-p *player*)
              (popup "You can't carry any more items.")
              (return))
-           (player-get *player* item)))
+           (player-get *player* item))
+  :tick)
+
+(defun drop-items ()
+  (if (player-inventory-empty-p *player*)
+    (progn (popup "You don't have anything to drop.")
+           nil)
+    (let ((item (menu "What do you want to drop?"
+                      (player/inventory *player*)
+                      #'holdable/description)))
+      (if item
+        (progn (player-drop *player* item)
+               :tick)
+        nil))))
 
 
 (defun world-map-input (window)
   (case (charms:get-char window)
     (#\q :quit)
     (#\h :help)
-    (#\g (get-items) :tick)
+    (#\g (get-items))
+    (#\d (drop-items))
     (:left  (move-player -1 0) :tick)
     (:right (move-player 1 0) :tick)
     (:up    (move-player 0 -1) :tick)