Partially working change to selected items

src/Dodge/Creature/Action.hs

@@ -3,9 +3,9 @@
 -- | Actions performed by creatures within the world
 module Dodge.Creature.Action (
     performActions,
-    stripNoItems,
+--    stripNoItems,
     setMinInvSize,
-    dropUnselected,
+--    dropUnselected,
     dropExcept,
     dropItem,
     blinkActionMousePos,
@@ -19,7 +19,7 @@ module Dodge.Creature.Action (
 ) where
 
 import Data.Bifunctor
-import Data.List (findIndex)
+--import Data.List (findIndex)
 import Data.Maybe
 import Dodge.Base
 import Dodge.Creature.Action.Blink
@@ -36,6 +36,7 @@ import Dodge.WallCreatureCollisions
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
+import Control.Monad
 
 performActions :: World -> Creature -> Creature
 performActions w cr =
@@ -147,29 +148,29 @@ performAction cr w ac = case ac of
 setMinInvSize :: Int -> Creature -> World -> World
 setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
 
--- maybe this should be removed...
-stripNoItems :: Creature -> World -> World
-stripNoItems cr =
-    organiseInvKeys (_crID cr)
-        . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just)
+---- maybe this should be removed...
+--stripNoItems :: Creature -> World -> World
+--stripNoItems cr =
+--    organiseInvKeys (_crID cr)
+--        . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just)
+--
+--organiseInvKeys :: Int -> World -> World
+--organiseInvKeys cid w =
+--    w & cWorld . lWorld . creatures . ix cid
+--        %~ ( (crInvSel . iselPos .~ newSelKey)
+--                . (crInv .~ newInv)
+--                . (crInvSel . iselAction .~ NoInvSelAction)
+--           )
+--  where
+--    cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid
+--    pairs = IM.toList (_crInv cr)
+--    newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
+--    newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
 
-organiseInvKeys :: Int -> World -> World
-organiseInvKeys cid w =
-    w & cWorld . lWorld . creatures . ix cid
-        %~ ( (crInvSel . iselPos .~ newSelKey)
-                . (crInv .~ newInv)
-                . (crInvSel . iselAction .~ NoInvSelAction)
-           )
-  where
-    cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid
-    pairs = IM.toList (_crInv cr)
-    newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
-    newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
-
-dropUnselected :: Creature -> World -> World
-dropUnselected cr w =
-    foldr (dropItem cr) w . IM.keys $
-        crSel cr `IM.delete` _crInv cr
+--dropUnselected :: Creature -> World -> World
+--dropUnselected cr w =
+--    foldr (dropItem cr) w . IM.keys $
+--        crSel cr `IM.delete` _crInv cr
 
 dropExcept :: Creature -> Int -> World -> World
 dropExcept cr invid w =
@@ -188,11 +189,11 @@ dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid -- . maybe
 
 -- | Get your creature to drop the item under the cursor.
 youDropItem :: World -> World
-youDropItem w
-    | _crInvLock (you w) || cursed = w
-    | otherwise =
-        w
-            & dropItem cr (crSel cr)
+youDropItem w = fromMaybe w $ do
+    curpos <- you w ^? crInvSel . isel . ispItem
+    guard $ not $ _crInvLock (you w) || cursed
+    return $ w
+            & dropItem cr curpos
             & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
   where
     cr = you w