From 2f0bb5115b85b8be3840eee18ca8f140087cb782 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 18 May 2023 09:52:46 +0100 Subject: [PATCH] Commit before implementing positional inventory --- src/Dodge/Creature.hs | 2 + src/Dodge/Creature/Impulse/UseItem.hs | 23 +---- src/Dodge/Data/Item/Combine.hs | 1 + .../Data/Item/Use/Consumption/LoadAction.hs | 1 + src/Dodge/Item.hs | 1 + src/Dodge/Item/Display.hs | 32 ++++--- src/Dodge/Item/Draw/SPic.hs | 2 + src/Dodge/Item/Equipment.hs | 11 ++- src/Dodge/Item/Info.hs | 85 +++++++++++-------- src/Dodge/Item/Weapon/TriggerType.hs | 14 ++- src/Dodge/Reloading.hs | 36 ++++++-- src/Dodge/Update/Input/InGame.hs | 2 +- 12 files changed, 132 insertions(+), 78 deletions(-) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 422ee2798..39c283cf0 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -262,4 +262,6 @@ stackedInventory = , flameThrower , poisonSprayer , launcher + , bulletBeltPack + , bulletBeltBracer ] diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index daef4f8a4..6b3f0fdf4 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -10,18 +10,15 @@ import Dodge.Hotkey import Control.Lens import Control.Monad import Data.Foldable -import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Cuse import Dodge.Data.World import Dodge.Euse import Dodge.HeldUse import Dodge.Inventory -import Dodge.Item.Location import Dodge.Luse import Dodge.Reloading import qualified IntMapHelp as IM -import qualified SDL useItemRightClick :: Creature -> World -> World useItemRightClick cr' w = fromMaybe (f w) $ do @@ -37,7 +34,6 @@ useItemRightClick cr' w = fromMaybe (f w) $ do itemEffect :: Creature -> Item -> World -> World itemEffect cr it w = case it ^. itUse of HeldUse{_heldUse = eff, _heldMods = usemods} -> - --hammerTest $ tryReload cr it (_input w) $ foldl' (&) (useHeld eff) (useMod usemods) it cr hammerTest $ foldl' (&) (useHeld eff) (useMod usemods) it cr LeftUse{} -> doequipmentchange EquipUse{} -> doequipmentchange @@ -56,21 +52,6 @@ itemEffect cr it w = case it ^. itUse of ( toggleEquipmentAt itRef cr ) -tryReload :: Creature -> Item -> Input -> (World -> World) -> World -> World -tryReload cr it theinput f - | cid == 0 && itNeedsLoading it && _mouseButtons theinput M.!? SDL.ButtonLeft == Just 0 = - cWorld . lWorld . creatures . ix cid %~ crToggleReloading - | otherwise = - (runIdentity . pointerToItemLocation (_itLocation it) (return . (itUse . heldHammer .~ HammerDown))) - . f - where - cid = _crID cr - -itNeedsLoading :: Item -> Bool -itNeedsLoading it = fromMaybe False $ do - internalammo <- it ^? itUse . heldConsumption . laSource . _InternalSource - return $ _iaLoaded internalammo == 0 || not (_iaPrimed internalammo) - toggleEquipmentAt :: Int -> Creature -> World -> World toggleEquipmentAt invid cr w = case getEquipmentAllocation w of DoNotMoveEquipment -> w @@ -120,14 +101,14 @@ useItemLeftClick cr w = fromMaybe w $ do invid <- cr ^? crManipulation . manObject . inInventory . ispItem ituse <- cr ^? crInv . ix invid . itUse case ituse of - HeldUse{} -> return $ hammerTest (cWorld . lWorld . creatures . ix (_crID cr) %~ crToggleReloading) + HeldUse{} -> return $ hammerTest (cWorld . lWorld . creatures . ix (_crID cr) %~ crUpdateLoadSource) ConsumeUse{} -> return $ useItemRightClick cr w EquipUse{} -> return $ useItemRightClick cr w LeftUse{} -> return $ useItemRightClick cr w _ -> Nothing where hammerTest f = case _crHammerPosition cr of - HammerUp -> f w + HammerUp -> f w & setuhamdown _ -> w & setuhamdown setuhamdown = cWorld . lWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown diff --git a/src/Dodge/Data/Item/Combine.hs b/src/Dodge/Data/Item/Combine.hs index 36ec51af7..2399e0f54 100644 --- a/src/Dodge/Data/Item/Combine.hs +++ b/src/Dodge/Data/Item/Combine.hs @@ -116,6 +116,7 @@ data EquipItemType | JETPACK | FUELPACK | BULLETBELTPACK + | BULLETBELTBRACER | BATTERYPACK | AUTODETECTOR Detector diff --git a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs index ae4290a78..17d9fb028 100644 --- a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs +++ b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs @@ -42,6 +42,7 @@ data InventoryManipulation data InvSelAction = NoInvSelAction + | AttachLoadSourceAction {_actionProgress :: Int} | ReloadAction {_actionProgress :: Int, _reloadAction :: LoadAction} deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index 1da6ddc73..170c41c5d 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -47,6 +47,7 @@ itemFromEquipType et = case et of BATTERYPACK -> batteryPack FUELPACK -> fuelPack BULLETBELTPACK -> bulletBeltPack + BULLETBELTBRACER -> bulletBeltBracer AUTODETECTOR d -> autoDetector d itemFromLeftType :: LeftItemType -> Item diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index 55ac494f4..0d67869f0 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -5,6 +5,7 @@ module Dodge.Item.Display ( itemBaseName, ) where +import Dodge.Item.Info import Data.Maybe import Data.Sequence import Dodge.Data.Creature @@ -55,7 +56,7 @@ showSelectedConsumption :: Creature -> ItemUse -> String showSelectedConsumption cr iu = case iu of HeldUse{} -> showReloadProgress cr (iu ^?! heldConsumption . laSource) LeftUse{} -> showAutoRechargeProgress (_leftConsumption iu) - EquipUse{} -> "" + EquipUse{_equipEffect = ee} -> showEquipmentNumber ee _ -> show $ iu ^?! useAmount . getItAmount -- partial, be careful if adding new data constructors showAutoRechargeProgress :: LeftConsumption -> String @@ -72,26 +73,36 @@ showReloadProgress cr ic = case cr ^? crManipulation . manObject . inInventory . InternalSource ia -> case ia ^? iaProgress . _Just . ix 0 of Nothing -> show $ ia ^. iaLoaded Just la -> show (_actionTime la) ++ showLoadActionType la ic - _ -> "X" + ExternalSource ea -> fromMaybe "X" $ do + i <- ea ^? _Just + itm <- cr ^? crInv . ix i + return $ show $ itemBaseName itm showConsumption :: ItemUse -> String showConsumption iu = case iu of HeldUse{} -> showReloadProgress' (_heldConsumption iu) LeftUse{} -> showAutoRechargeProgress (_leftConsumption iu) - EquipUse {_equipEffect = ee} -> showEUseNumber ee + EquipUse{_equipEffect = ee} -> showEquipmentNumber ee _ -> show $ iu ^?! useAmount . getItAmount -showEUseNumber :: EquipEffect -> String -showEUseNumber ee = case _eeUse ee of +showEquipmentNumber :: EquipEffect -> String +showEquipmentNumber ee = case _eeUse ee of EFuelSource x _ -> show x + EAmmoSource {_euseAmmoAmount = x} -> showIntKMG' x + EBatterySource {_euseBatteryAmount = x} -> show x _ -> "" showReloadProgress' :: HeldConsumption -> String -showReloadProgress' ic = case ic ^? laSource . _InternalSource . iaProgress . _Just . ix 0 of - Nothing -> fromMaybe "X" $ do - x <- ic ^? laSource . _InternalSource . iaLoaded - return $ show x - Just la -> show (_actionTime la) ++ showLoadActionType la (_laSource ic) +showReloadProgress' ic = case ic ^? laSource of + Just (InternalSource ia) -> case ia ^? iaProgress . _Just . ix 0 of + Nothing -> fromMaybe "" $ do + x <- ic ^? laSource . _InternalSource . iaLoaded + return $ show x + Just la -> show (_actionTime la) ++ showLoadActionType la (_laSource ic) + Just (ExternalSource ea) -> fromMaybe "X" $ do + i <- ea ^? _Just + return $ show i + _ -> "" showLoadActionType :: LoadAction -> AmmoSource -> String showLoadActionType la as = case la of @@ -101,7 +112,6 @@ showLoadActionType la as = case la of LoadPrime{} -> "P" where x = maybe "" show $ as ^? _InternalSource . iaLoaded - maybeWarmupStatus :: Item -> Maybe String maybeWarmupStatus it = case it ^? itUse . heldDelay . warmMax of diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index 596640885..26e9d5763 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/src/Dodge/Item/Draw/SPic.hs @@ -52,6 +52,8 @@ equipItemSPic et _ = case et of noPic $ colorSH yellow $ upperPrismPolyMT 10 $ polyCirc 3 5 BULLETBELTPACK -> noPic $ colorSH green backpackShape + BULLETBELTBRACER + -> noPic (colorSH green $ upperPrismPolySU 3 $ rectWH 2 2) AUTODETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPolySU 3 $ rectWH 2 2) backpackShape :: Shape diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index c264b5d52..cd78d47e0 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -13,6 +13,7 @@ module Dodge.Item.Equipment ( fuelPack, batteryPack, bulletBeltPack, + bulletBeltBracer, speedLegs, jumpLegs, flameShield, @@ -76,7 +77,15 @@ bulletBeltPack = & itUse . equipEffect . eeSite .~ GoesOnBack & itType . iyBase .~ EQUIP BULLETBELTPACK & itUse . equipEffect . eeAttachPos .~ V3 (-9) 0 10 - & itUse . equipEffect . eeUse .~ EAmmoSource 10000 10000 BulletSource Nothing + & itUse . equipEffect . eeUse .~ EAmmoSource 2000 2000 BulletSource Nothing + +bulletBeltBracer :: Item +bulletBeltBracer = + defaultEquipment + & itUse . equipEffect . eeSite .~ GoesOnWrist + & itType . iyBase .~ EQUIP BULLETBELTBRACER + & itUse . equipEffect . eeAttachPos .~ V3 (-9) 0 10 + & itUse . equipEffect . eeUse .~ EAmmoSource 100 100 BulletSource Nothing jetPack :: Item jetPack = diff --git a/src/Dodge/Item/Info.hs b/src/Dodge/Item/Info.hs index fcfcdb4e3..aa478608e 100644 --- a/src/Dodge/Item/Info.hs +++ b/src/Dodge/Item/Info.hs @@ -1,16 +1,17 @@ module Dodge.Item.Info where -import StringHelp -import Dodge.Module.Info import Data.Char -import Dodge.Data.Item import qualified Data.Map.Strict as M +import Dodge.Data.Item +import Dodge.Module.Info import LensHelp +import StringHelp itemInfo :: Item -> String -itemInfo itm = itmBaseInfo itm ++ " " ++ itmUsageInfo itm - ++ itmSpaceInfo itm - ++ itmModuleInfo (itm ^. itType . iyModules) +itemInfo itm = + itmBaseInfo itm ++ " " ++ itmUsageInfo itm + ++ itmSpaceInfo itm + ++ itmModuleInfo (itm ^. itType . iyModules) itmSpaceInfo :: Item -> String itmSpaceInfo itm = case ceiling $ _itInvSize itm of @@ -43,20 +44,34 @@ showInt i = case i of 12 -> "a dozen" _ -> "more than a dozen" +showIntKMG :: Int -> String +showIntKMG x + | x < 1000 = show x + | x < 1000000 = show (x `div` 1000) ++ "K" + | x < 1000000000 = show (x `div` 1000000) ++ "M" + | otherwise = show (x `div` 1000000000) ++ "G" + +showIntKMG' :: Int -> String +showIntKMG' x + | x < 1000 = show x + | x < 1000000 = take 3 (show ((fromIntegral x :: Float) / 1000)) ++ "K" + | x < 1000000000 = take 3 (show ((fromIntegral x :: Float) / 1000000)) ++ "M" + | otherwise = take 3 (show ((fromIntegral x :: Float) / 1000000000)) ++ "G" + heldInfo :: HeldItemType -> String heldInfo hit = case hit of BANGSTICK 1 -> "A firearm with a short barrel that requires reloading after each shot." - BANGSTICK i -> over _head toUpper (showInt i)++" small gun barrels strapped together. Each barrel must be individually loaded, but not all need be loaded for the weapon to fire. All loaded barrels discharge simultaneously, with significant spread." + BANGSTICK i -> over _head toUpper (showInt i) ++ " small gun barrels strapped together. Each barrel must be individually loaded, but not all need be loaded for the weapon to fire. All loaded barrels discharge simultaneously, with significant spread." PISTOL -> "A small firearm fed by a magazine. The entire magazine must be replaced when reloading the weapon." REVOLVER -> "A small firearm fed by a revolving cylinder. Single shot and load." - REVOLVERX i -> "A small firearm fed by "++ showInt i++ "revolving cylinders." + REVOLVERX i -> "A small firearm fed by " ++ showInt i ++ "revolving cylinders." MACHINEPISTOL -> "A small firearm automatically, and extremely rapidly, fed by a magazine. The entire magazine must be replaced when reloading the weapon." AUTOPISTOL -> "A small firearm automatically fed by a magazine. The entire magazine must be replaced when reloading the weapon." SMG -> "A small firearm with an attached stock for stability." BANGCONE -> "A container for debris. Exposive action propels the debris away from the user. Quite unweildy." BLUNDERBUSS -> "A container for debris on the end of a stick. Explosive action propels the debris away from the user." GRAPECANNON 1 -> "A large container for debris on the end of a stick. Explosive action propels the debris away from the user." - GRAPECANNON i -> "An "++ replicate (i-1) 'X' ++"L container for debris on the end of a stick. Explosive action propels the debris away from the user." + GRAPECANNON i -> "An " ++ replicate (i -1) 'X' ++ "L container for debris on the end of a stick. Explosive action propels the debris away from the user." MINIGUNX i -> over _head toUpper (showInt i) ++ " gun barrels that revolve rapidly around a central stick. Requires considerable time to warm up, but has an extremely rapid rate of fire. It is also extremely difficult to stabilise." VOLLEYGUN i -> over _head toUpper (showInt i) ++ " gun barrels lined up to be roughly parallel. Each barrel must be individually loaded, but not all need be loaded for the weapon to fire. All loaded barrels discharge simultaneously." RIFLE -> "A firearm with a mid length barrel that requires reloading after each shot." @@ -82,17 +97,17 @@ heldInfo hit = case hit of LASWIDE _ -> "A weapon that continuously emits photons in a narrow beam. The beam expands as the weapon heats up." TRACTORGUN -> "An item that produces a beam of gravitons." LAUNCHER -> "A large tube that can launch self propelled projectiles. Moving the tube after launch will cause the projectile to spin." - LAUNCHERX i -> over _head toUpper (showInt i)++" tubes that can launch self propelled projectiles. Tubes that do not face forward launch their projecitles at an angle." + LAUNCHERX i -> over _head toUpper (showInt i) ++ " tubes that can launch self propelled projectiles. Tubes that do not face forward launch their projecitles at an angle." REMOTELAUNCHER -> "A large tube that can launch self propelled projectiles. Contains a transmitter allowing for remote control of launched projectiles." POISONSPRAYER -> "A weapon that releases noxious gases." DRONELAUNCHER -> "A device for launching drones." SHATTERGUN -> "A seismic device that shatters hard items in its line of fire." FORCEFIELDGUN -> "A device that produces a durable forcefield." - HELDDETECTOR d -> "A device that detects "++detectorInfo d ++" in an expanding radius." + HELDDETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius." TORCH -> "A stick with a light on the end." BINOCULARS -> "Two cylinders with lenses. Scroll to zoom." FLATSHIELD -> "A panel of metal that blocks unwanted objects from the front of the user." - KEYCARD i -> "A keycard. It is labelled " ++ show i++ "." + KEYCARD i -> "A keycard. It is labelled " ++ show i ++ "." leftInfo :: LeftItemType -> String leftInfo lit = case lit of @@ -114,18 +129,17 @@ equipInfo eit = case eit of INVISIBILITYEQUIPMENT _ -> "A device that bends light around its user." BRAINHAT -> "An iq enhancer. Useless." HAT -> "A hat." - TARGETINGHAT tt -> "Headwear that "++ targetingInfo tt + TARGETINGHAT tt -> "Headwear that " ++ targetingInfo tt HEADLAMP -> "A torch strapped to a hat." POWERLEGS -> "Strength enhancing legs." SPEEDLEGS -> "Speed enhancing legs." JUMPLEGS -> "Jump enhancing legs." - JETPACK -> "A device enabling flight." FUELPACK -> "A liquid container with attached hose." BULLETBELTPACK -> "A container holding a long belt of bullets." + BULLETBELTBRACER -> "A container holding a long belt of bullets." BATTERYPACK -> "A collection of batteries with a universal adapter." - - AUTODETECTOR d -> "A device that detects "++detectorInfo d ++" in an expanding radius. Pulses automatically. " + AUTODETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius. Pulses automatically. " targetingInfo :: TargetType -> String targetingInfo tt = case tt of @@ -146,10 +160,8 @@ craftInfo fit = case fit of TUBE -> "A wide rigid cylinder." HARDWARE -> "A collection of equipment and devices useful for general construction." SPRING -> "An object that exerts an opposing force when compressed or stretched." - HOSE -> "A flexible cylinder." TAPE -> "A strip of material with an adhesive side." - CAN -> "A small metal cylindrical container." TIN -> "A small metal continer." STEELDRUM -> "A metal cylindrical container." @@ -193,12 +205,9 @@ craftInfo fit = case fit of TIMEMODULE -> "A device that can affect temporality." SIZEMODULE -> "A device that can affect physical size." GRAVITYMODULE -> "A device that can affect gravitational fields." - TARGETMODULE _ -> "A targeting module." - FLAKCRAFT -> "Creates flak bullets." FRAGCRAFT -> "Creates fragmentation bullets." - detectorInfo :: Detector -> String detectorInfo d = case d of @@ -209,8 +218,9 @@ detectorInfo d = case d of itmUsageInfo :: Item -> String itmUsageInfo itm = case itm ^. itType . iyBase of HELD _ -> heldPositionInfo itm - LEFT _ -> "This item can be equipped" ++ itmEquipSiteInfo itm - ++ ". When equipped, it can be activated." + LEFT _ -> + "This item can be equipped" ++ itmEquipSiteInfo itm + ++ ". When equipped, it can be activated." EQUIP _ -> "This item can be equipped " ++ itmEquipSiteInfo itm ++ "." Consumable _ -> "This item can be consumed." CRAFT _ -> "" @@ -221,9 +231,10 @@ heldPositionInfo = maybe undefined aimStanceInfo . (^? itUse . heldAim . aimStan aimStanceInfo :: AimStance -> String aimStanceInfo as = case as of - TwoHandTwist -> "It is held in two hands along its length." + TwoHandTwist -> "It is held in two hands along its length." TwoHandFlat -> "It is held in two hands at its sides." OneHand -> "It is held in one hand." + -- LeaveHolstered -> "It is to be left holstered." itmEquipSiteInfo :: Item -> String @@ -238,23 +249,27 @@ equipSiteInfo es = case es of GoesOnLegs -> " on both legs" itmModuleInfo :: M.Map ModuleSlot ItemModuleType -> String -itmModuleInfo m +itmModuleInfo m | m == mempty = "" - | otherwise = mms ++ ems + | otherwise = mms ++ ems where - (mademods,emptymods) = M.partition (/= EMPTYMODULE) m - mms | mademods == mempty = "" - | otherwise = " Modifications have been made " - ++ makeCommaList (map moduleInfo $ M.keys mademods) - ems | emptymods == mempty = "" - | otherwise = " Modifications can be made " - ++ makeCommaList (map moduleInfo $ M.keys emptymods) + (mademods, emptymods) = M.partition (/= EMPTYMODULE) m + mms + | mademods == mempty = "" + | otherwise = + " Modifications have been made " + ++ makeCommaList (map moduleInfo $ M.keys mademods) + ems + | emptymods == mempty = "" + | otherwise = + " Modifications can be made " + ++ makeCommaList (map moduleInfo $ M.keys emptymods) makeCommaList :: [String] -> String makeCommaList [] = "" makeCommaList [x] = x ++ "." -makeCommaList [x,y] = x ++ " and " ++ y ++ "." -makeCommaList (x:xs) = x ++ ", " ++ makeCommaList xs +makeCommaList [x, y] = x ++ " and " ++ y ++ "." +makeCommaList (x : xs) = x ++ ", " ++ makeCommaList xs moduleInfo :: ModuleSlot -> String moduleInfo imt = case imt of diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 5a8977b5a..df902b1bf 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -79,6 +79,7 @@ import Geometry import LensHelp import RandomHelp import Sound.Data +import qualified IntMapHelp as IM type ChainEffect = (Item -> Creature -> World -> World) -> @@ -361,9 +362,18 @@ useAmmoUpTo amAmount eff item cr = useAmmoAmount :: Int -> ChainEffect useAmmoAmount amAmount eff item cr = eff item cr - . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itUse . heldConsumption . laSource . _InternalSource . iaLoaded -~ amAmount) + . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ useAmmoAmount' itref amAmount) -- . _InternalSource . iaLoaded -~ amAmount) where - itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change + itref = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change + +useAmmoAmount' :: Int -> Int -> IM.IntMap Item -> IM.IntMap Item +useAmmoAmount' itref x inv = case inv ^? ix itref . itUse . heldConsumption . laSource of + Just InternalSource{} + -> inv & ix itref . itUse . heldConsumption . laSource . _InternalSource . iaLoaded -~ x + Just (ExternalSource (Just eqid)) + -> inv & ix eqid . itUse . equipEffect . eeUse . euseAmmoAmount -~ x + _ -> inv +-- . crInv . ix itRef . itUse . heldConsumption . laSource {- | Applies a world effect after an item use cooldown check. diff --git a/src/Dodge/Reloading.hs b/src/Dodge/Reloading.hs index 651b7c317..7fc71408d 100644 --- a/src/Dodge/Reloading.hs +++ b/src/Dodge/Reloading.hs @@ -1,6 +1,6 @@ module Dodge.Reloading ( crCancelReloading, - crToggleReloading, + crUpdateLoadSource, stepReloading, tryStartLoading, ) where @@ -9,6 +9,7 @@ import Dodge.Data.Item.Use.Consumption.LoadAction import Control.Lens import Dodge.Data.Creature import Data.Maybe +import qualified IntMapHelp as IM crCancelReloading :: Creature -> Creature crCancelReloading cr = @@ -41,16 +42,37 @@ tryNextLoadAction cr = case cr ^? crManipulation . manObject . inInventory of & crManipulation . manObject . inInventory . iselAction . reloadAction .~ la _ -> cr -crToggleReloading :: Creature -> Creature -crToggleReloading cr = case cr ^? crManipulation . manObject . inInventory . iselAction of - Just ReloadAction{} -> cr & crManipulation . manObject . inInventory . iselAction .~ NoInvSelAction - _ -> cr & tryStartLoading +crUpdateLoadSource :: Creature -> Creature +crUpdateLoadSource cr = case cr ^? crManipulation . manObject . inInventory . iselAction of + Just NoInvSelAction -> cr & tryStartLoading + _ -> cr & crManipulation . manObject . inInventory . iselAction .~ NoInvSelAction tryStartLoading :: Creature -> Creature tryStartLoading cr = fromMaybe cr $ do i <- cr ^? crManipulation . manObject . inInventory . ispItem - hc <- cr ^? crInv . ix i . itUse . heldConsumption . laSource . _InternalSource - return $ startLoading hc cr + as <- cr ^? crInv . ix i . itUse . heldConsumption . laSource + case as of + InternalSource ia -> return $ startLoading ia cr + ExternalSource ea -> return $ toggleExternalLoadSource i ea cr + +toggleExternalLoadSource :: Int -> Maybe Int -> Creature -> Creature +toggleExternalLoadSource invid mcureqid cr = fromMaybe cr $ do + st <- inv ^? ix invid . itUse . heldConsumption . laSourceType + (eqid,eqitm) <- ifind (\_ a -> Just st == a ^? itUse . equipEffect . eeUse . euseAmmoSourceType) msplit + return $ cr + & crInv . ix invid . itUse . heldConsumption . laSource . _ExternalSource ?~ eqid + & crInv . ix eqid . itUse . equipEffect . eeUse . euseAmmoLink ?~ invid + & detachExternalSource eqitm + where + inv = cr ^. crInv + msplit = fromMaybe inv $ do + cureqid <- mcureqid + return . snd $ IM.split cureqid inv + +detachExternalSource :: Item -> Creature -> Creature +detachExternalSource itm cr = fromMaybe cr $ do + i <- itm ^? itUse . equipEffect . eeUse . euseAmmoLink . _Just + return $ cr & crInv . ix i . itUse . heldConsumption . laSource . _ExternalSource .~ Nothing startLoading :: InternalAmmo -> Creature -> Creature startLoading ic cr = case ic ^? iaProgress . _Just . ix 0 of diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index a598faa0b..1c8a7031f 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -116,7 +116,7 @@ updateInitialPressInGame uv sc = case sc of ScancodeP -> pauseGame uv ScancodeF -> over uvWorld youDropItem uv ScancodeM -> toggleMap uv - ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crToggleReloading uv + ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crUpdateLoadSource uv ScancodeT -> over uvWorld testEvent uv ScancodeX -> uv & uvWorld %~ toggleTweakInv ScancodeC -> toggleCombineInv uv