Mapper, ARHUD, radar sweeps update. Add dropper items

src/Dodge/HeldUse.hs

@@ -3,17 +3,18 @@
 
 module Dodge.HeldUse (
     heldEffect,
+    gadgetEffect,
     heldEffectNoHammerCheck,
     mcUseHeld,
 ) where
 
+import qualified Data.IntMap.Strict as IM
+import Dodge.Creature.Action
 import Color
 import Control.Applicative
 import Control.Monad
 import Data.Maybe
 import Dodge.Base.Collide
---import Dodge.Base.Coordinate
-import Dodge.Creature.Action.Blink
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Dodge.Data.MuzzleEffect
@@ -35,6 +36,20 @@ import Picture.Base
 import RandomHelp
 import qualified SDL
 
+gadgetEffect ::
+    PressType ->
+    LocationLDT ItemLink ComposedItem ->
+    Creature ->
+    World ->
+    World
+gadgetEffect pt loc
+    | UseHeld {} <- loc ^. locLDT . ldtValue . _1 . itUse = heldEffect pt 
+        (bimap _iatType (^. _1) (loc ^. locLDT))
+    | DROPPER x <- loc ^. locLDT . ldtValue . _1 . itType
+    , Just i <- loc ^? locLDT . ldtValue . _1 . itUse . uInt
+    , pt == InitialPress = dropInventoryPath i x loc
+    | otherwise = const id
+
 heldEffect ::
     PressType ->
     LabelDoubleTree ComposeLinkType Item ->
@@ -329,7 +344,8 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme
                 w
         MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
         MuzzleShatter -> shootShatter itm cr w
-        MuzzleDetector -> itemDetectorEffect itm (getAttachedMapper itmtree) cr w
+        MuzzleDetector -> itemDetectorEffect itm (getAttachedSFLink MapperSF itmtree) 
+            (getAttachedSFLink ARHUDSF itmtree) cr w
         MuzzleBlink -> unsafeBlinkAction cr w
         MuzzleUnsafeBlink -> blinkActionMousePos cr w
         MuzzleRewind -> useRewindGun (itm ^. itID) w
@@ -339,18 +355,20 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme
     mid = magtree ^? ldtValue . itLocation . ilInvID
     itm = itmtree ^. ldtValue
 
+getAttachedSFLink :: ItemStructuralFunction 
+    -> LabelDoubleTree ComposeLinkType Item -> Maybe (NewInt ItmInt)
+getAttachedSFLink sf = (^? ldtRight . folding (lookup (SFLink sf)) . ldtValue . itID)
 
-getAttachedMapper :: LabelDoubleTree ComposeLinkType Item -> Maybe (NewInt ItmInt)
-getAttachedMapper =
-    (^? ldtRight . folding (lookup (SFLink MapperSF)) . ldtValue . itID)
-
-itemDetectorEffect :: Item -> Maybe (NewInt ItmInt) -> Creature -> World -> World
-itemDetectorEffect itm itid cr w = fromMaybe w $ do
+itemDetectorEffect :: Item -> Maybe (NewInt ItmInt) 
+    -> Maybe (NewInt ItmInt) -> Creature -> World -> World
+itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do
     DETECTOR dt <- itm ^? itType
-    return $ case dt of
-        ITEMDETECTOR -> aRadarPulse itid ObItem cr w
-        CREATUREDETECTOR -> aRadarPulse itid ObCreature cr w
-        WALLDETECTOR -> aRadarPulse itid ObWall cr w
+    return $ aRadarPulse (itm ^. itID) mitid armitid (f dt) cr w
+  where
+    f ITEMDETECTOR = ObItem
+    f CREATUREDETECTOR = ObCreature
+    f WALLDETECTOR = ObWall
+
 
 walkNozzle :: Int -> Muzzle -> Item -> Creature -> World -> World
 walkNozzle mzid mz itm cr w = fromMaybe w $ do
@@ -759,6 +777,22 @@ useRewindGun i =
             , _scrollItemID = i
             }
 
+dropInventoryPath :: Int -> InventoryPathing -> LocationLDT ItemLink ComposedItem 
+    -> Creature
+    -> World -> World
+dropInventoryPath i ip loc cr w = case ip of
+    ABSOLUTE -> fromMaybe w $ do
+        guard $ i `IM.member` (cr ^. crInv)
+        return $ dropItem cr i w
+    RELCURS -> fromMaybe w $ do
+        j <- cr ^? crManipulation . manObject . imSelectedItem
+        guard $ (i + j) `IM.member` (cr ^. crInv)
+        return $ dropItem cr (i + j) w
+    RELITEM -> fromMaybe w $ do
+        j <- loc ^? locLDT . ldtValue . _1 . itLocation . ilInvID
+        guard $ (i + j) `IM.member` (cr ^. crInv)
+        return $ dropItem cr (i + j) w
+
 --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
 --    [w'] -> w & cwTime . maybeWorld .~ Just' w'
 --    (w' : ws) -> w