justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup constructors FooUse -> UseFoo

Browse Source
This commit is contained in:
justin
2024-10-03 20:39:41 +01:00
parent 6b4cf596b1
commit 127d85e7ce
10 changed files with 49 additions and 92 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ghcidOutput
+1 -1
View File
@@ -1 +1 @@
All good (601 modules, at 11:42:53)
All good (601 modules, at 20:39:35)
src/Dodge/Creature/Impulse/UseItem.hs
+9 -11
View File
@@ -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
src/Dodge/Creature/State.hs
+8 -16
View File
@@ -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
src/Dodge/Data/Item/Use.hs
+5 -5
View File
@@ -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)
src/Dodge/Default/Item.hs
+7 -2
View File
@@ -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
src/Dodge/HeldUse.hs
+3 -3
View File
@@ -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 ->
src/Dodge/Item/Display.hs
+5 -23
View File
@@ -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
src/Dodge/Item/Scope.hs
+7 -8
View File
@@ -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
src/Dodge/Item/Weapon/TriggerType.hs
-18
View File
@@ -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.
src/Dodge/Update/Camera.hs
+4 -5
View File
@@ -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