From 127d85e7ce9a3f6a13900a456248545ea415c7db Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 3 Oct 2024 20:39:41 +0100 Subject: [PATCH] Cleanup constructors FooUse -> UseFoo --- ghcidOutput | 2 +- src/Dodge/Creature/Impulse/UseItem.hs | 20 +++++++++---------- src/Dodge/Creature/State.hs | 24 ++++++++--------------- src/Dodge/Data/Item/Use.hs | 10 +++++----- src/Dodge/Default/Item.hs | 9 +++++++-- src/Dodge/HeldUse.hs | 6 +++--- src/Dodge/Item/Display.hs | 28 +++++---------------------- src/Dodge/Item/Scope.hs | 15 +++++++------- src/Dodge/Item/Weapon/TriggerType.hs | 18 ----------------- src/Dodge/Update/Camera.hs | 9 ++++----- 10 files changed, 49 insertions(+), 92 deletions(-) diff --git a/ghcidOutput b/ghcidOutput index 622c451ca..8e9d9bbc5 100644 --- a/ghcidOutput +++ b/ghcidOutput @@ -1 +1 @@ -All good (601 modules, at 11:42:53) +All good (601 modules, at 20:39:35) diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 02b10b52b..66266e25e 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -11,7 +11,6 @@ import Dodge.Data.ComposedItem import Dodge.Data.DoubleTree import Control.Lens import Control.Monad ---import Data.Foldable import Data.Maybe import Dodge.Cuse import Dodge.Data.World @@ -33,20 +32,20 @@ useRootItem crid w = fromMaybe w $ do & worldEventFlags . at InventoryChange ?~ () itemUseEffect :: Creature -> LabelDoubleTree ComposeLinkType Item -> World -> World -itemUseEffect cr it w = case it ^. ldtValue . itUse of - UseHeld{} -> heldEffect it cr w +itemUseEffect cr itmtree w = case itmtree ^. ldtValue . itUse of + UseHeld{} -> heldEffect itmtree cr w & pointerToItem itm . itUse . heldHammer .~ HammerDown UseHotkey{} -> doequipmentchange UseEquip{} -> doequipmentchange - (UseConsume eff) -> useC eff (_ldtValue it) cr w - CraftUse{} -> w - UseAttach{} -> selectUse it cr w - TargetingUse {} -> w + (UseConsume eff) -> useC eff (_ldtValue itmtree) cr w + UseCraft{} -> w + UseAttach{} -> selectUse itmtree cr w + UseTargeting {} -> w UseAmmoMag{} -> w - ScopeUse{} -> w - BulletModUse{} -> w + UseScope{} -> w + UseBulletMod{} -> w where - itm = it ^. ldtValue + itm = itmtree ^. ldtValue doequipmentchange = fromMaybe w $ do guard (_crHammerPosition cr == HammerUp) invid <- itm ^? itLocation . ilInvID @@ -111,7 +110,6 @@ useItemLeftClick cr w = fromMaybe w $ do _ -> Nothing useItemLeftClick' :: Creature -> World -> World ---useItemLeftClick' cr' w = fromMaybe (f w) $ do useItemLeftClick' cr' w = fromMaybe w $ do cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr') itRef <- cr ^? crManipulation . manObject . imSelectedItem diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 61bc1efba..2aaf0a9a5 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -229,14 +229,10 @@ itemInvSideEffect cr itm = case _itType itm of -- this probably needs to be set to null when dropped as well? updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World updateItemTargeting tt cr itm w = case tt of - _ - | not isattached -> - w - & pointItUse . tgPos .~ Nothing - & pointItUse . tgActive .~ False - TARGETLASER - | crIsAiming cr -> - w + _ | not isattached -> w + & pointItUse . tgPos .~ Nothing + & pointItUse . tgActive .~ False + TARGETLASER | crIsAiming cr -> w & cWorld . lWorld . lasers .:~ LaserStart { _lpPhaseV = 1 @@ -246,19 +242,15 @@ updateItemTargeting tt cr itm w = case tt of , _lpType = TargetingLaser (_itID itm) } TARGETLASER -> w & pointItUse . tgPos .~ Nothing - TargetRBPress - | rbpressed -> - w + TargetRBPress | rbpressed -> w & pointItUse . tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just & pointItUse . tgActive .~ True - TargetRBPress -> - w + TargetRBPress -> w & pointItUse . tgPos .~ Nothing & pointItUse . tgActive .~ False TargetRBCreature -> w & pointItUse %~ setRBCreatureTargeting cr w - TargetCursor -> - w & pointItUse - .~ TargetingUse + TargetCursor -> w + & pointItUse .~ UseTargeting (Just (mouseWorldPos (w ^. input) (w ^. wCam))) Nothing True diff --git a/src/Dodge/Data/Item/Use.hs b/src/Dodge/Data/Item/Use.hs index 219f7c361..a47e704e1 100644 --- a/src/Dodge/Data/Item/Use.hs +++ b/src/Dodge/Data/Item/Use.hs @@ -51,21 +51,21 @@ data ItemUse } | UseConsume { _cUse :: Cuse } | UseEquip { _uequipEffect :: EquipEffect } - | CraftUse + | UseCraft | UseAttach {_uaParams :: AttachParams} | UseAmmoMag { _amagLoadStatus :: ReloadStatus , _amagParams :: AmmoParams , _amagType :: AmmoType } - | ScopeUse { _scopeScope :: Scope } - | TargetingUse + | UseScope { _uScope :: Scope } + | UseTargeting { _tgPos :: Maybe Point2 , _tgID :: Maybe Int , _tgActive :: Bool } - | BulletModUse - { _buMod :: BulletMod + | UseBulletMod + { _ubMod :: BulletMod } deriving (Eq, Show, Read) diff --git a/src/Dodge/Default/Item.hs b/src/Dodge/Default/Item.hs index 4f0540082..d361f8b0c 100644 --- a/src/Dodge/Default/Item.hs +++ b/src/Dodge/Default/Item.hs @@ -1,5 +1,10 @@ module Dodge.Default.Item ( - module Dodge.Default.Item, + defaultHeldItem, + singleAmmo, + defaultBulletWeapon, + defaultLeftItem, + defaultCraftItem, + defaultConsumable, module Dodge.Default.Item.Use, ) where @@ -33,7 +38,7 @@ defaultLeftItem :: Item defaultLeftItem = defaultHeldItem & itUse .~ defaultLeftUse defaultCraftItem :: Item -defaultCraftItem = defaultHeldItem & itUse .~ CraftUse +defaultCraftItem = defaultHeldItem & itUse .~ UseCraft singleAmmo :: a -> IM.IntMap a singleAmmo x = IM.insert 0 x mempty diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index 27e01f8aa..88b6b1a71 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -304,14 +304,14 @@ getBulletType itmtree magtree mz cr w = targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these? tp <- targetingtree ^? ldtValue . itUse . tgPos . _Just attree <- lookup AmmoTargetingLink (magtree ^. ldtLeft) - bt <- attree ^? ldtValue . itUse . buMod . bmTrajectory + bt <- attree ^? ldtValue . itUse . ubMod . bmTrajectory return $ getBulletTrajectory mz (itmtree ^. ldtValue) bt tp cr w bpayload = fromMaybe BulSpark $ do attree <- lookup AmmoPayloadLink (magtree ^. ldtLeft) - attree ^? ldtValue . itUse . buMod . bmPayload + attree ^? ldtValue . itUse . ubMod . bmPayload beffect = fromMaybe DestroyBullet $ do attree <- lookup AmmoEffectLink (magtree ^. ldtLeft) - attree ^? ldtValue . itUse . buMod . bmEffect + attree ^? ldtValue . itUse . ubMod . bmEffect getBulletTrajectory :: Muzzle -> diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index 2d7d4fe84..61d07fb35 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -1,36 +1,18 @@ module Dodge.Item.Display ( itemDisplay, --- canAttachTargeting, itemString, itemBaseName, basicItemDisplay, ) where ---import Control.Applicative ---import Control.Monad import ShortShow import Data.Maybe import Dodge.Data.Creature import LensHelp import Padding ---canAttachTargeting :: TargetingType -> Item -> Bool ---canAttachTargeting TARGETLASER _ = True ---canAttachTargeting _ itm = --- isJust (itm ^? itType . iyModules . ix ModBulletTrajectory . imtBulletTrajectoryType) --- || Just LAUNCHHOME == (itm ^? itType . iyModules . ix ModLauncherHoming) - ---targetingTypeString :: TargetType -> String ---targetingTypeString tt = case tt of --- TARGETLASER -> "LASER" --- TargetRBPress -> "POS" --- TargetRBLine -> "" --- TargetRBCreature -> "LIFEFORM" --- TargetCursor -> "CURSOR" - itemDisplay :: Creature -> Item -> [String] itemDisplay cr itm = - --itemDisplayWithNumber (showConsumption cr it) it zipWithDefaults id (leftPad 15 ' ') itemDisplayPad (basicItemDisplay itm) (itemNumberDisplay cr itm) zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c] @@ -113,15 +95,15 @@ itemNumberDisplay cr itm = case iu of UseHeld{} -> [] UseHotkey{} -> [showAutoRechargeProgress (_leftConsumption iu)] UseEquip{} -> showEquipmentNumber cr itm - CraftUse -> [] + UseCraft -> [] UseConsume {} -> [] UseAttach {} -> [] UseAmmoMag {} -> [maybe "" shortShow $ itm ^? itUse . amagLoadStatus . iaLoaded] - ScopeUse OpticScope {_opticZoom = x} -> [shortShow x] - ScopeUse {} -> [] - TargetingUse {_tgPos = mp} -> [maybe "" shortShow mp] + UseScope OpticScope {_opticZoom = x} -> [shortShow x] + UseScope {} -> [] + UseTargeting {_tgPos = mp} -> [maybe "" shortShow mp] -- this could be cleaner here... - BulletModUse {} -> mempty + UseBulletMod {} -> mempty where iu = itm ^?! itUse diff --git a/src/Dodge/Item/Scope.hs b/src/Dodge/Item/Scope.hs index e5a4aad88..ac6dd0c07 100644 --- a/src/Dodge/Item/Scope.hs +++ b/src/Dodge/Item/Scope.hs @@ -3,7 +3,6 @@ module Dodge.Item.Scope ( targetingScope, remoteScreen, homingModule, - fletchingModule, bulletTargetingModule, augmentedHUD, bulletModule, @@ -18,24 +17,25 @@ import Dodge.Default.Item zoomScope :: Item zoomScope = defaultHeldItem & itType .~ ATTACH ZOOMSCOPE - & itUse .~ ScopeUse OpticScope{_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5} + & itUse .~ UseScope OpticScope{_opticPos = 0, _opticZoom = 1, _opticDefaultZoom = 0.5} targetingScope :: TargetingType -> Item targetingScope tt = defaultHeldItem & itType .~ TARGETING tt - & itUse .~ TargetingUse Nothing Nothing False + & itUse .~ UseTargeting + { _tgPos = Nothing + , _tgID = Nothing + , _tgActive = False + } homingModule :: Item homingModule = makeAttach HOMINGMODULE -fletchingModule :: Item -fletchingModule = bulletTargetingModule FlechetteTrajectoryType - bulletModule :: BulletMod -> Item bulletModule bm = defaultHeldItem & itType .~ BULLETMOD bm - & itUse .~ BulletModUse bm + & itUse .~ UseBulletMod {_ubMod = bm} bulletTargetingModule :: BulletTrajectoryType -> Item bulletTargetingModule = bulletModule . BulletModTrajectory @@ -49,4 +49,3 @@ augmentedHUD = makeAttach AUGMENTEDHUD remoteScreen :: Item remoteScreen = makeAttach REMOTESCREEN & itUse . uaParams .~ APLinkProjectile Nothing - diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 6946fe216..e7ddfbc0f 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -79,27 +79,9 @@ lockInvFor i f it cr = -- pos = addZ 0 $ _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir -- ps = replicateM 20 randOnUnitSphere & evalState $ _randGen w --- TODO create a trigger that does different things on first and continued --- fire. ---ammoCheckI :: ChainEffect ---ammoCheckI eff itm cr w = fromMaybe (failsound w) $ do --- atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0 --- leftitms <- itm ^? ldtLeft --- mag <- lookup (AmmoInLink 0 atype) leftitms --- x <- mag ^? ldtValue . itUse . amagLoadStatus . iaLoaded --- guard $ x > 0 --- return $ eff itm cr w -- & cWorld . lWorld . creatures . ix (_crID cr) %~ crCancelReloading --- where --- failsound = case w ^? input . mouseButtons . ix SDL.ButtonLeft of --- Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing --- _ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing - itUseCharge :: Int -> Item -> Item itUseCharge x = itUse . leftConsumption . arLoaded %~ (max 0 . subtract x) ---itUseAmmo :: Int -> Item -> Item ---itUseAmmo x = itUse . heldConsumption . laSource . _InternalSource . iaLoaded %~ (max 0 . subtract x) - --{- | Fires at an increasing rate. --Has different effect after first fire. --Applies ammo check and use cooldown check. diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 27c5f62d9..3616c0568 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -6,7 +6,6 @@ module Dodge.Update.Camera ( ) where import Bound ---import Control.Applicative import Control.Monad import Data.Foldable import qualified Data.Map.Strict as M @@ -94,16 +93,16 @@ moveZoomCamera cfig theinput cr w campos = offset = fromMaybe noscopeoffset $ do guard (SDL.ButtonRight `M.member` _mouseButtons theinput) i <- cr ^? crManipulation . manObject . imSelectedItem - fmap docamrot (cr ^? crInv . ix i . itUse . scopeScope . opticPos) + fmap docamrot (cr ^? crInv . ix i . itUse . uScope . opticPos) noscopeoffset = docamrot $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do i <- cr ^? crManipulation . manObject . imSelectedItem - cr ^? crInv . ix i . itUse . scopeScope . opticZoom + cr ^? crInv . ix i . itUse . uScope . opticZoom idealDefaultZoom = clipZoom wallZoom newDefaultZoom = fromMaybe (changeZoom (campos ^. camDefaultZoom) idealDefaultZoom) $ do i <- cr ^? crManipulation . manObject . imSelectedItem - cr ^? crInv . ix i . itUse . scopeScope . opticZoom + cr ^? crInv . ix i . itUse . uScope . opticZoom idealItemZoom = fromMaybe 1 $ do guard $ crIsAiming cr i <- cr ^? crManipulation . manObject . imSelectedItem @@ -136,7 +135,7 @@ updateScopeZoom' i w w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) (w ^. input . mousePos) | otherwise = w & wppointer %~ resetscope where - wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itUse . scopeScope + wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itUse . uScope resetscope (OpticScope _ _ defz) = OpticScope (V2 0 0) defz defz resetscope otherAtt = otherAtt