Make examine inventory controlled by item, perhaps still buggy

src/Dodge/Creature/Action.hs

@@ -3,9 +3,7 @@
 -- | Actions performed by creatures within the world
 module Dodge.Creature.Action (
     performActions,
-    --    stripNoItems,
     setMinInvSize,
-    --    dropUnselected,
     dropExcept,
     dropItem,
     blinkActionMousePos,
@@ -13,12 +11,9 @@ module Dodge.Creature.Action (
     unsafeBlinkAction,
     sizeSelf,
     youDropItem,
---    pickUpItem,
 ) where
 
 import Control.Applicative
---import Data.List (findIndex)
-
 import Control.Monad
 import Data.Bifunctor
 import Data.Maybe
@@ -31,6 +26,7 @@ import Dodge.Default
 import Dodge.FloatFunction
 import Dodge.FloorItem
 import Dodge.Inventory
+import Dodge.ItEffect
 --import Dodge.Inventory.Add
 import Dodge.Path
 import Dodge.SoundLogic
@@ -176,11 +172,15 @@ dropExcept cr invid w =
 -- why not a cid (Int)?
 dropItem :: Creature -> Int -> World -> World
 dropItem cr invid =
-    maybeshiftseldown
-    .   rmInvItem (_crID cr) invid
+    doanyitemdropeffect
+        . maybeshiftseldown
+        . rmInvItem (_crID cr) invid
         . copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
         . soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
   where
+    doanyitemdropeffect = fromMaybe id $ do
+        rmf <- itm ^? itEffect . ieOnDrop
+        return $ doInvEffect rmf itm cr
     itm = fromMaybe (error "dropItem cannot find item") $ cr ^? crInv . ix invid
     maybeshiftseldown w = fromMaybe w $ do
         3 <- w ^? hud . hudElement . diSelection . _Just . _1

src/Dodge/Creature/Impulse/UseItem.hs

@@ -4,8 +4,8 @@ module Dodge.Creature.Impulse.UseItem (
     useItem,
 ) where
 
+import Dodge.ToggleExamine
 import Control.Lens
-import Control.Monad
 import Data.Maybe
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
@@ -15,6 +15,7 @@ import Dodge.Euse
 import Dodge.HeldUse
 import Dodge.Inventory
 import Dodge.Item.Grammar
+import Dodge.Item.Location
 import qualified IntMapHelp as IM
 
 useItem :: Int -> PressType -> World -> Maybe World
@@ -30,27 +31,33 @@ useItemLoc ::
     PressType ->
     World ->
     Maybe World
-useItemLoc cr loc pt w = case loc ^. locLDT . ldtValue . _2 of
-    HeldPlatformSF -> do
-        guard $ fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsRoot
-        guard $ cr ^. crStance . posture == Aiming
+useItemLoc cr loc pt w
+    | HeldPlatformSF <- sf
+      , fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsRoot
+      , cr ^. crStance . posture == Aiming =
         return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
-    GadgetPlatformSF ->
-        return $
-            heldEffect pt (bimap _iatType (^. _1) ldt) cr w
-    UnderBarrelPlatformSF -> do
-        guard $ fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
-        guard $ cr ^. crStance . posture == Aiming
+    | GadgetPlatformSF <- sf =
         return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
-    RemoteDetonatorSF -> do
-        guard $ pt == InitialPress
+    | UnderBarrelPlatformSF <- sf
+      , fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
+      , cr ^. crStance . posture == Aiming =
+        return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
+    | RemoteDetonatorSF <- sf
+      , pt == InitialPress =
         return $ activateDetonator ldt w
-    _ | isJust $ itm ^? itUse . uequipEffect -> do
-        guard $ pt == InitialPress
-        invid' <- itm ^? itLocation . ilInvID
+    | ITEMSCANNER <- itm ^. itType
+      , pt == InitialPress =
+        return $ toggleExamineInv w
+    | Just b <- itm ^? itUse . useToggle
+      , pt == InitialPress =
+        return $ w & pointerToItem itm . itUse . useToggle .~ not b
+    | isJust $ itm ^? itUse . uequipEffect
+      , pt == InitialPress
+      , Just invid' <- itm ^? itLocation . ilInvID =
         return $ toggleEquipmentAt invid' cr w
-    _ -> Nothing
+    | otherwise = Nothing
   where
+    sf = loc ^. locLDT . ldtValue . _2
     ldt = loc ^. locLDT
     itm = ldt ^. ldtValue . _1
 

src/Dodge/Creature/YourControl.hs

@@ -23,8 +23,8 @@ import qualified SDL
 yourControl :: Creature -> World -> World
 yourControl _ w
     | inTextInputFocus w = w
-    | Just NoSubInventory{} <- w ^? hud . hudElement . subInventory =
-        w
+    | Just x <- w ^? hud . hudElement . subInventory 
+    , f x = w
             & cWorld . lWorld . creatures . ix 0
                 %~ (wasdWithAiming w . setCrPosture pkeys)
             & tryClickUse pkeys
@@ -32,6 +32,9 @@ yourControl _ w
     | otherwise =
         w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
   where
+    f NoSubInventory = True
+    f ExamineInventory = True
+    f _ = False
     pkeys = w ^. input . mouseButtons
 
 handleHotkeys :: World -> World