Tweak use location

src/Dodge/Creature/Impulse/UseItem.hs

@@ -1,16 +1,14 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Dodge.Creature.Impulse.UseItem (
-    useItem,
-) where
+module Dodge.Creature.Impulse.UseItem (useItem) where
 
-import Dodge.Equipment
 import Control.Lens
 import Data.Maybe
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Dodge.Data.World
 import Dodge.DoubleTree
+import Dodge.Equipment
 import Dodge.HeldUse
 import Dodge.Inventory
 import Dodge.Item.Grammar
@@ -21,25 +19,21 @@ useItem :: Int -> PressType -> World -> Maybe World
 useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
     cr <- w ^? cWorld . lWorld . creatures . ix 0
     itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2
-    let usedloc = useLocation itmloc
+    let usedloc = chooseUseLocation itmloc
     useItemLoc cr usedloc pt w
 
-useItemLoc :: Creature ->
-    LocationLDT ItemLink OItem ->
-    PressType ->
-    World ->
-    Maybe World
+useItemLoc :: Creature -> LocationLDT ItemLink OItem -> PressType -> World -> Maybe World
 useItemLoc cr loc pt w
     | HeldPlatformSF <- sf
       , fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsRoot
-      , Aiming {} <- cr ^. crStance . posture =
-        return $ heldEffect pt (bimap id id ldt) cr w
+      , Aiming{} <- cr ^. crStance . posture =
+        return $ gadgetEffect pt loc cr w
     | GadgetPlatformSF <- sf =
         return $ gadgetEffect pt loc cr w
     | UnderBarrelPlatformSF <- sf
       , fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
-      , Aiming {} <- cr ^. crStance . posture =
-        return $ heldEffect pt (bimap id id ldt) cr w
+      , Aiming{} <- cr ^. crStance . posture =
+        return $ gadgetEffect pt loc cr w
     | RemoteDetonatorSF <- sf
       , pt == InitialPress =
         return $ activateDetonator ldt w
@@ -62,15 +56,15 @@ useItemLoc cr loc pt w
     ldt = loc ^. locLDT
     itm = ldt ^. ldtValue . _1
 
-useLocation :: LocationLDT ItemLink OItem -> LocationLDT ItemLink OItem
-useLocation loc
+chooseUseLocation :: LocationLDT ItemLink OItem -> LocationLDT ItemLink OItem
+chooseUseLocation loc
     | isJust $ loc ^? locLDT . ldtValue . _1 . itType . ibtEquip = loc
     | isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0 =
         loc
     | sf <- loc ^. locLDT . ldtValue . _2
       , structureUseAtLoc sf =
         loc
-    | otherwise = locToTop loc
+    | otherwise = maybe loc chooseUseLocation $ locUp loc
 
 structureUseAtLoc :: ItemStructuralFunction -> Bool
 structureUseAtLoc = \case

src/Dodge/Creature/State.hs

@@ -3,7 +3,6 @@ module Dodge.Creature.State (
     doDamage,
 ) where
 
-import Data.Bifunctor
 import Dodge.Data.DoubleTree
 import Dodge.Item.Orientation
 import Dodge.Item.UseDelay
@@ -218,7 +217,7 @@ doAnyEquipmentEffect loc cr = case itm ^? itLocation . ilEquipSite . _Just of
 tryUseParent :: LocationLDT ItemLink OItem -> World -> World
 tryUseParent loc w = fromMaybe w $ do
     t <- locUp loc
-    let t' = bimap id id $ t ^. locLDT
+    let t' = t ^. locLDT
     cr <- w ^? cWorld . lWorld . creatures . ix 0
     return $ heldEffectNoHammerCheck t' cr w