Fix bug concerning effects when dropping items

2023-05-03 22:12:19 +01:00
parent d99d612e68
commit 487280a475
5 changed files with 72 additions and 114 deletions
@@ -2,7 +2,6 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
-
 module Dodge.Data.Item.Use.Equipment (
    module Dodge.Data.Equipment.Misc,
    module Dodge.Data.Item.Use.Equipment,
@@ -1,23 +1,23 @@
 module Dodge.Euse where

+import Color
 import Control.Monad
 import Data.Maybe
-import Dodge.LightSource
-import Dodge.Item.HeldOffset
-import Dodge.Wall.Create
-import Color
-import Dodge.Default.Wall
-import Dodge.Creature.Test
 import Dodge.Creature.HandPos
-import Geometry
-import Dodge.Wall.Move
-import Dodge.Wall.Delete
-import Dodge.Wall.ForceField
-import Dodge.Item.Location
+import Dodge.Creature.Test
 import Dodge.Data.World
+import Dodge.Default.Wall
+import Dodge.Item.HeldOffset
+import Dodge.Item.Location
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.Radar
+import Dodge.LightSource
 import Dodge.SoundLogic.ExternallyGeneratedSounds
+import Dodge.Wall.Create
+import Dodge.Wall.Delete
+import Dodge.Wall.ForceField
+import Dodge.Wall.Move
+import Geometry
 import qualified IntMapHelp as IM
 import LensHelp

@@ -32,7 +32,7 @@ useE eo = case eo of
    EonWristShield -> onEquipWristShield
    EoffWristShield -> onRemoveWristShield
    EFuelSource 0 _ -> const . const id
-    EFuelSource {} -> trySiphonFuel
+    EFuelSource{} -> trySiphonFuel

 trySiphonFuel :: Item -> Creature -> World -> World
 trySiphonFuel itm cr w = fromMaybe w $ do
@@ -45,14 +45,15 @@ trySiphonFuel itm cr w = fromMaybe w $ do
    amax <- la ^? laMax
    acur <- la ^? laLoaded
    guard (amax > acur)
-    return $ w & cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ 
-            ( (ix hix . itUse . heldConsumption . laLoaded +~ 1)
-            . (ix eix . itUse . equipEffect . eeUse . euseFuelAmount -~ 1)
-            )
+    return $
+        w & cWorld . lWorld . creatures . ix (_crID cr) . crInv
+            %~ ( (ix hix . itUse . heldConsumption . laLoaded +~ 1)
+                    . (ix eix . itUse . equipEffect . eeUse . euseFuelAmount -~ 1)
+               )

 isGas :: AmmoType -> Bool
 isGas a = case a of
-    GasAmmo {} -> True
+    GasAmmo{} -> True
    _ -> False

 useMagShield :: Item -> Creature -> World -> World
@@ -87,9 +88,7 @@ onRemoveWristShield itm _ =
        return $ deleteWallID i

 setWristShieldPos :: Item -> Creature -> World -> World
-setWristShieldPos itm cr w =
-    w
-        & moveWallIDUnsafe i wlline
+setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
  where
    i = _eparamID $ _eeParams $ _equipEffect $ _itUse itm
    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
@@ -51,10 +51,10 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
    _ ->
        w
            & pointcid %~ crCancelReloading
-            & pointcid . crInv %~ f
+            & removeAnySlotEquipment    -- the ordering
+            & dounequipfunction         -- of these is
+            & pointcid . crInv %~ f     -- important
            & pointcid . crLeftInvSel . lisMPos %~ g'
-            & removeAnySlotEquipment
-            & dounequipfunction
            & doanyitemeffect
            & pointcid . crInvEquipped %~ IM.delete invid
            & pointcid . crInvEquipped %~ IM.mapKeys g
@@ -100,7 +100,6 @@ rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crMan
    Just i -> rmInvItem cid i w
    Nothing -> w

-
 -- this looks ugly...
 updateCloseObjects :: World -> World
 updateCloseObjects w =
@@ -132,7 +131,7 @@ updateCloseObjects w =
 updateRBList :: World -> World
 updateRBList w
    | w ^? rbOptions . opItemID == mcurrentitemid =
-        w & setEquipAllocation & setEquipActivation
+        w & setEquipAllocationActivation
    | otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
        i <- cr ^? crManipulation . manObject . inInventory . ispItem
        esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
@@ -147,8 +146,7 @@ updateRBList w
                        , _opAllocateEquipment = DoNotMoveEquipment
                        , _opActivateEquipment = NoChangeActivateEquipment
                        }
-                & setEquipAllocation
-                & setEquipActivation
+                & setEquipAllocationActivation
  where
    mcurrentitemid = do
        i <- cr ^? crManipulation . manObject . inInventory . ispItem
@@ -166,45 +164,37 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
  where
    hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep

+setEquipAllocationActivation :: World -> World
+setEquipAllocationActivation = setEquipActivation . setEquipAllocation
+
 setEquipAllocation :: World -> World
 setEquipAllocation w = fromMaybe w $ do
    curpos <- you w ^? crManipulation . manObject . inInventory . ispItem
-    return $ case _rbOptions w of
-        EquipOptions{_opEquip = es, _opSel = i} ->
-            case you w ^? crInvEquipped . ix curpos of
-                Just epos
-                    | es !! i == epos ->
-                        w & rbOptions . opAllocateEquipment
-                            .~ RemoveEquipment
-                                { _allocOldPos = epos
-                                }
-                Just epos
-                    | isJust (you w ^? crEquipment . ix (es !! i)) ->
-                        w & rbOptions . opAllocateEquipment
-                            .~ SwapEquipment
-                                { _allocOldPos = epos
-                                , _allocNewPos = es !! i
-                                , _allocSwapID = _crEquipment (you w) M.! (es !! i)
-                                }
-                Just epos ->
-                    w & rbOptions . opAllocateEquipment
-                        .~ MoveEquipment
-                            { _allocOldPos = epos
-                            , _allocNewPos = es !! i
-                            }
-                Nothing
-                    | isJust (you w ^? crEquipment . ix (es !! i)) ->
-                        w & rbOptions . opAllocateEquipment
-                            .~ ReplaceEquipment
-                                { _allocNewPos = es !! i
-                                , _allocRemoveID = _crEquipment (you w) M.! (es !! i)
-                                }
-                Nothing ->
-                    w & rbOptions . opAllocateEquipment
-                        .~ PutOnEquipment
-                            { _allocNewPos = es !! i
-                            }
-        _ -> w
+    i <- w ^? rbOptions . opSel
+    es <- w ^? rbOptions . opEquip . ix i
+    return $
+        w & rbOptions . opAllocateEquipment .~ case you w ^? crInvEquipped . ix curpos of
+            Just epos
+                | es == epos -> RemoveEquipment{_allocOldPos = epos}
+            Just epos
+                | isJust (you w ^? crEquipment . ix es) ->
+                    SwapEquipment
+                        { _allocOldPos = epos
+                        , _allocNewPos = es
+                        , _allocSwapID = _crEquipment (you w) M.! es
+                        }
+            Just epos ->
+                MoveEquipment
+                    { _allocOldPos = epos
+                    , _allocNewPos = es
+                    }
+            Nothing
+                | isJust (you w ^? crEquipment . ix es) ->
+                    ReplaceEquipment
+                        { _allocNewPos = es
+                        , _allocRemoveID = _crEquipment (you w) M.! es
+                        }
+            Nothing -> PutOnEquipment{_allocNewPos = es}

 setEquipActivation :: World -> World
 setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
@@ -263,26 +253,33 @@ closeObjScrollDir x

 changeSwapSel :: Int -> World -> World
 changeSwapSel yi w
-    | yi == 0   = w
-    | yi > 0    = foldr ($) w $ replicate yi (changeSwapWith $ f IM.cycleLT)
+    | yi == 0 = w
+    | yi > 0 = foldr ($) w $ replicate yi (changeSwapWith $ f IM.cycleLT)
    | otherwise = foldr ($) w $ replicate (negate yi) (changeSwapWith $ f IM.cycleGT)
  where
    f g i m = fst <$> g i m

-changeSwapClose :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int)
-    -> Int -> World -> World
+changeSwapClose ::
+    (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
+    Int ->
+    World ->
+    World
 changeSwapClose f i w = fromMaybe w $ do
    ss <- w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems
    k <- f i ss
-    return $ w
+    return $
+        w
            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject
                .~ k
            & hud . closeObjects %~ swapIndices i k
            & hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
            & worldEventFlags . at InventoryChange ?~ ()

-changeSwapInv :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int)
-    -> Int -> World -> World
+changeSwapInv ::
+    (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
+    Int ->
+    World ->
+    World
 changeSwapInv f i w = fromMaybe w $ do
    ss <- w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems
    k <- f i ss
@@ -309,42 +306,10 @@ changeSwapInv f i w = fromMaybe w $ do

 changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
 changeSwapWith f w = case w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just of
-    Just (0,i) -> w & changeSwapInv f i
-    Just (3,i) -> w & changeSwapClose f i
+    Just (0, i) -> w & changeSwapInv f i
+    Just (3, i) -> w & changeSwapClose f i
    _ -> w

--changeSwapInvSel' :: Int -> World -> World
--changeSwapInvSel' k w = case you w ^? crManipulation . manObject of
--    Just (InInventory (SelItem i _)) ->
--        w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i
--            & worldEventFlags . at InventoryChange ?~ ()
--    Just (InNearby (SelCloseObject i)) ->
--        w
--            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject
--                .~ ((i - k) `mod` numCO)
--            & hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO)
--            & worldEventFlags . at InventoryChange ?~ ()
--    _ -> w
--  where
--    updatecreature i =
--        (crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i))
--            . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i)
--            . (crManipulation . manObject . inInventory . ispItem %~ (`mod` n) . subtract k)
--            . (crInvEquipped %~ IM.safeSwapKeys i (swapi i))
--            . swapSite i (swapi i)
--            . swapSite (swapi i) i
--    swapSite a b = case cr ^? crInvEquipped . ix a of
--        Just epos -> crEquipment . ix epos .~ b
--        Nothing -> id
--    cr = you w
--    swapi i = (i - k) `mod` n
--    updateLeftInvSel i li
--        | i == li = swapi i
--        | swapi i == li = i
--        | otherwise = li
--    n = length $ _crInv cr
--    numCO = length $ w ^. hud . closeObjects
-
 scrollAugInvSel :: Int -> World -> World
 scrollAugInvSel yi w
    | yi == 0 = w
@@ -4,15 +4,11 @@
 Extra weapon effects, supplementing explicit use effects.
 -}
 module Dodge.Item.Weapon.ExtraEffect (
-    -- itemLaserScopeEffect
    autoSonarEffect,
    autoEffect,
    autoRadarEffect,
-    --    , rbSetTarget
 ) where

--import Dodge.Item.Attachment.Data
-
 import Dodge.Data.World
 import Dodge.RadarSweep
 import Dodge.SoundLogic
@@ -83,7 +83,8 @@ optionsToSelections maxlines u allops pmo = case pmo of
        | maxlines >= length allops = allops
        | otherwise = take (maxlines - 2) (drop offset allops ++ repeat dummyMenuOption) ++ [cycleOptionsOption]
    maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops)
-    cycleOptionsOption = Toggle cycleOptions (const (MODString ("MORE OPTIONS " ++ show n ++ "/" ++ show m)))
+    cycleOptionsOption = Toggle cycleOptions 
+        (const (MODString ("MORE OPTIONS " ++ show n ++ "/" ++ show m)))
    l = length allops
    m = div (l - 1) (max 1 (maxlines - 2)) + 1
    n = div (offset + 1) (max 1 (maxlines - 2)) + 1
@@ -108,8 +109,7 @@ colStrToSelItem (col, str) =
        { _siPictures = [str]
        , _siHeight = 1
        , _siIsSelectable = True
-        , --, _siWidth = length str
-          _siColor = col
+        , _siColor = col
        , _siOffX = 0
        , _siPayload = id
        }
@@ -129,8 +129,7 @@ menuOptionToSelectionItem w padAmount mo =
        { _siPictures = [optionText]
        , _siHeight = 1
        , _siIsSelectable = isselectable
-        , --, _siWidth = length optionText
-          _siColor = thecol
+        , _siColor = thecol
        , _siOffX = 0
        , _siPayload = (f, g)
        }