Fix bug concerning effects when dropping items

This commit is contained in:
2023-05-03 22:12:19 +01:00
parent d99d612e68
commit 487280a475
5 changed files with 72 additions and 114 deletions
-1
View File
@@ -2,7 +2,6 @@
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Use.Equipment ( module Dodge.Data.Item.Use.Equipment (
module Dodge.Data.Equipment.Misc, module Dodge.Data.Equipment.Misc,
module Dodge.Data.Item.Use.Equipment, module Dodge.Data.Item.Use.Equipment,
+19 -20
View File
@@ -1,23 +1,23 @@
module Dodge.Euse where module Dodge.Euse where
import Color
import Control.Monad import Control.Monad
import Data.Maybe 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 Dodge.Creature.HandPos
import Geometry import Dodge.Creature.Test
import Dodge.Wall.Move
import Dodge.Wall.Delete
import Dodge.Wall.ForceField
import Dodge.Item.Location
import Dodge.Data.World 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.ExtraEffect
import Dodge.Item.Weapon.Radar import Dodge.Item.Weapon.Radar
import Dodge.LightSource
import Dodge.SoundLogic.ExternallyGeneratedSounds 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 qualified IntMapHelp as IM
import LensHelp import LensHelp
@@ -32,7 +32,7 @@ useE eo = case eo of
EonWristShield -> onEquipWristShield EonWristShield -> onEquipWristShield
EoffWristShield -> onRemoveWristShield EoffWristShield -> onRemoveWristShield
EFuelSource 0 _ -> const . const id EFuelSource 0 _ -> const . const id
EFuelSource {} -> trySiphonFuel EFuelSource{} -> trySiphonFuel
trySiphonFuel :: Item -> Creature -> World -> World trySiphonFuel :: Item -> Creature -> World -> World
trySiphonFuel itm cr w = fromMaybe w $ do trySiphonFuel itm cr w = fromMaybe w $ do
@@ -45,14 +45,15 @@ trySiphonFuel itm cr w = fromMaybe w $ do
amax <- la ^? laMax amax <- la ^? laMax
acur <- la ^? laLoaded acur <- la ^? laLoaded
guard (amax > acur) guard (amax > acur)
return $ w & cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ return $
( (ix hix . itUse . heldConsumption . laLoaded +~ 1) w & cWorld . lWorld . creatures . ix (_crID cr) . crInv
. (ix eix . itUse . equipEffect . eeUse . euseFuelAmount -~ 1) %~ ( (ix hix . itUse . heldConsumption . laLoaded +~ 1)
) . (ix eix . itUse . equipEffect . eeUse . euseFuelAmount -~ 1)
)
isGas :: AmmoType -> Bool isGas :: AmmoType -> Bool
isGas a = case a of isGas a = case a of
GasAmmo {} -> True GasAmmo{} -> True
_ -> False _ -> False
useMagShield :: Item -> Creature -> World -> World useMagShield :: Item -> Creature -> World -> World
@@ -87,9 +88,7 @@ onRemoveWristShield itm _ =
return $ deleteWallID i return $ deleteWallID i
setWristShieldPos :: Item -> Creature -> World -> World setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w = setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
w
& moveWallIDUnsafe i wlline
where where
i = _eparamID $ _eeParams $ _equipEffect $ _itUse itm i = _eparamID $ _eeParams $ _equipEffect $ _itUse itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0)) wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
+49 -84
View File
@@ -51,10 +51,10 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
_ -> _ ->
w w
& pointcid %~ crCancelReloading & pointcid %~ crCancelReloading
& pointcid . crInv %~ f & removeAnySlotEquipment -- the ordering
& dounequipfunction -- of these is
& pointcid . crInv %~ f -- important
& pointcid . crLeftInvSel . lisMPos %~ g' & pointcid . crLeftInvSel . lisMPos %~ g'
& removeAnySlotEquipment
& dounequipfunction
& doanyitemeffect & doanyitemeffect
& pointcid . crInvEquipped %~ IM.delete invid & pointcid . crInvEquipped %~ IM.delete invid
& pointcid . crInvEquipped %~ IM.mapKeys g & 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 Just i -> rmInvItem cid i w
Nothing -> w Nothing -> w
-- this looks ugly... -- this looks ugly...
updateCloseObjects :: World -> World updateCloseObjects :: World -> World
updateCloseObjects w = updateCloseObjects w =
@@ -132,7 +131,7 @@ updateCloseObjects w =
updateRBList :: World -> World updateRBList :: World -> World
updateRBList w updateRBList w
| w ^? rbOptions . opItemID == mcurrentitemid = | w ^? rbOptions . opItemID == mcurrentitemid =
w & setEquipAllocation & setEquipActivation w & setEquipAllocationActivation
| otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do | otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
i <- cr ^? crManipulation . manObject . inInventory . ispItem i <- cr ^? crManipulation . manObject . inInventory . ispItem
esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
@@ -147,8 +146,7 @@ updateRBList w
, _opAllocateEquipment = DoNotMoveEquipment , _opAllocateEquipment = DoNotMoveEquipment
, _opActivateEquipment = NoChangeActivateEquipment , _opActivateEquipment = NoChangeActivateEquipment
} }
& setEquipAllocation & setEquipAllocationActivation
& setEquipActivation
where where
mcurrentitemid = do mcurrentitemid = do
i <- cr ^? crManipulation . manObject . inInventory . ispItem i <- cr ^? crManipulation . manObject . inInventory . ispItem
@@ -166,45 +164,37 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
where where
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
setEquipAllocationActivation :: World -> World
setEquipAllocationActivation = setEquipActivation . setEquipAllocation
setEquipAllocation :: World -> World setEquipAllocation :: World -> World
setEquipAllocation w = fromMaybe w $ do setEquipAllocation w = fromMaybe w $ do
curpos <- you w ^? crManipulation . manObject . inInventory . ispItem curpos <- you w ^? crManipulation . manObject . inInventory . ispItem
return $ case _rbOptions w of i <- w ^? rbOptions . opSel
EquipOptions{_opEquip = es, _opSel = i} -> es <- w ^? rbOptions . opEquip . ix i
case you w ^? crInvEquipped . ix curpos of return $
Just epos w & rbOptions . opAllocateEquipment .~ case you w ^? crInvEquipped . ix curpos of
| es !! i == epos -> Just epos
w & rbOptions . opAllocateEquipment | es == epos -> RemoveEquipment{_allocOldPos = epos}
.~ RemoveEquipment Just epos
{ _allocOldPos = epos | isJust (you w ^? crEquipment . ix es) ->
} SwapEquipment
Just epos { _allocOldPos = epos
| isJust (you w ^? crEquipment . ix (es !! i)) -> , _allocNewPos = es
w & rbOptions . opAllocateEquipment , _allocSwapID = _crEquipment (you w) M.! es
.~ SwapEquipment }
{ _allocOldPos = epos Just epos ->
, _allocNewPos = es !! i MoveEquipment
, _allocSwapID = _crEquipment (you w) M.! (es !! i) { _allocOldPos = epos
} , _allocNewPos = es
Just epos -> }
w & rbOptions . opAllocateEquipment Nothing
.~ MoveEquipment | isJust (you w ^? crEquipment . ix es) ->
{ _allocOldPos = epos ReplaceEquipment
, _allocNewPos = es !! i { _allocNewPos = es
} , _allocRemoveID = _crEquipment (you w) M.! es
Nothing }
| isJust (you w ^? crEquipment . ix (es !! i)) -> Nothing -> PutOnEquipment{_allocNewPos = es}
w & rbOptions . opAllocateEquipment
.~ ReplaceEquipment
{ _allocNewPos = es !! i
, _allocRemoveID = _crEquipment (you w) M.! (es !! i)
}
Nothing ->
w & rbOptions . opAllocateEquipment
.~ PutOnEquipment
{ _allocNewPos = es !! i
}
_ -> w
setEquipActivation :: World -> World setEquipActivation :: World -> World
setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
@@ -263,26 +253,33 @@ closeObjScrollDir x
changeSwapSel :: Int -> World -> World changeSwapSel :: Int -> World -> World
changeSwapSel yi w changeSwapSel yi w
| yi == 0 = w | yi == 0 = w
| yi > 0 = foldr ($) w $ replicate yi (changeSwapWith $ f IM.cycleLT) | yi > 0 = foldr ($) w $ replicate yi (changeSwapWith $ f IM.cycleLT)
| otherwise = foldr ($) w $ replicate (negate yi) (changeSwapWith $ f IM.cycleGT) | otherwise = foldr ($) w $ replicate (negate yi) (changeSwapWith $ f IM.cycleGT)
where where
f g i m = fst <$> g i m f g i m = fst <$> g i m
changeSwapClose :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) changeSwapClose ::
-> Int -> World -> World (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
Int ->
World ->
World
changeSwapClose f i w = fromMaybe w $ do changeSwapClose f i w = fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems ss <- w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems
k <- f i ss k <- f i ss
return $ w return $
w
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject
.~ k .~ k
& hud . closeObjects %~ swapIndices i k & hud . closeObjects %~ swapIndices i k
& hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k & hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
& worldEventFlags . at InventoryChange ?~ () & worldEventFlags . at InventoryChange ?~ ()
changeSwapInv :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) changeSwapInv ::
-> Int -> World -> World (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
Int ->
World ->
World
changeSwapInv f i w = fromMaybe w $ do changeSwapInv f i w = fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems ss <- w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems
k <- f i ss 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 :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
changeSwapWith f w = case w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just of changeSwapWith f w = case w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just of
Just (0,i) -> w & changeSwapInv f i Just (0, i) -> w & changeSwapInv f i
Just (3,i) -> w & changeSwapClose f i Just (3, i) -> w & changeSwapClose f i
_ -> w _ -> 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 :: Int -> World -> World
scrollAugInvSel yi w scrollAugInvSel yi w
| yi == 0 = w | yi == 0 = w
-4
View File
@@ -4,15 +4,11 @@
Extra weapon effects, supplementing explicit use effects. Extra weapon effects, supplementing explicit use effects.
-} -}
module Dodge.Item.Weapon.ExtraEffect ( module Dodge.Item.Weapon.ExtraEffect (
-- itemLaserScopeEffect
autoSonarEffect, autoSonarEffect,
autoEffect, autoEffect,
autoRadarEffect, autoRadarEffect,
-- , rbSetTarget
) where ) where
--import Dodge.Item.Attachment.Data
import Dodge.Data.World import Dodge.Data.World
import Dodge.RadarSweep import Dodge.RadarSweep
import Dodge.SoundLogic import Dodge.SoundLogic
+4 -5
View File
@@ -83,7 +83,8 @@ optionsToSelections maxlines u allops pmo = case pmo of
| maxlines >= length allops = allops | maxlines >= length allops = allops
| otherwise = take (maxlines - 2) (drop offset allops ++ repeat dummyMenuOption) ++ [cycleOptionsOption] | otherwise = take (maxlines - 2) (drop offset allops ++ repeat dummyMenuOption) ++ [cycleOptionsOption]
maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops) 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 l = length allops
m = div (l - 1) (max 1 (maxlines - 2)) + 1 m = div (l - 1) (max 1 (maxlines - 2)) + 1
n = div (offset + 1) (max 1 (maxlines - 2)) + 1 n = div (offset + 1) (max 1 (maxlines - 2)) + 1
@@ -108,8 +109,7 @@ colStrToSelItem (col, str) =
{ _siPictures = [str] { _siPictures = [str]
, _siHeight = 1 , _siHeight = 1
, _siIsSelectable = True , _siIsSelectable = True
, --, _siWidth = length str , _siColor = col
_siColor = col
, _siOffX = 0 , _siOffX = 0
, _siPayload = id , _siPayload = id
} }
@@ -129,8 +129,7 @@ menuOptionToSelectionItem w padAmount mo =
{ _siPictures = [optionText] { _siPictures = [optionText]
, _siHeight = 1 , _siHeight = 1
, _siIsSelectable = isselectable , _siIsSelectable = isselectable
, --, _siWidth = length optionText , _siColor = thecol
_siColor = thecol
, _siOffX = 0 , _siOffX = 0
, _siPayload = (f, g) , _siPayload = (f, g)
} }