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

Cleanup, hlints

Browse Source
This commit is contained in:
justin
2025-07-12 21:35:35 +01:00
parent 5544e891c5
commit dc631263da
9 changed files with 58 additions and 74 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/UseItem.hs
+4 -4
View File
@@ -19,7 +19,7 @@ useItem :: Int -> PressType -> World -> Maybe World
useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
itmloc <- invIndents (_crInv cr) ^? ix invid . _2
useItemLoc cr (itmloc) pt w
useItemLoc cr itmloc pt w
useItemLoc :: Creature -> LocationDT OItem -> PressType -> World -> Maybe World
useItemLoc cr loc pt w
@@ -30,13 +30,13 @@ useItemLoc cr loc pt w
| LaserWeaponSF <- sf
, fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached
, Aiming{} <- cr ^. crStance . posture =
return $ gadgetEffect pt (loc) cr w
return $ gadgetEffect pt loc cr w
| GadgetPlatformSF <- sf =
return $ gadgetEffect pt (loc) cr w
return $ gadgetEffect pt loc cr w
| UnderBarrelPlatformSF <- sf
, fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached
, Aiming{} <- cr ^. crStance . posture =
return $ gadgetEffect pt (loc) cr w
return $ gadgetEffect pt loc cr w
| RemoteDetonatorSF <- sf
, pt == InitialPress =
return $ activateDetonator ldt w
src/Dodge/Creature/State.hs
+5 -6
View File
@@ -153,7 +153,7 @@ invRootItemEffs cr =
invItemLocUpdate :: Creature -> LocationDT OItem -> World -> World
invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
ATTACH BULLETSYNTH -> trySynthBullet loc w
EQUIP WRIST_ECG | haspulse -> tryUseParent (loc) w
EQUIP WRIST_ECG | haspulse -> tryUseParent loc w
COPIER _ -> copierItemUpdate itm cr w
HELD FLATSHIELD -> rootNotrootEff createShieldWall removeShieldWall itm cr w
HELD MINIGUNX{} -> coolMinigun itm w
@@ -293,8 +293,7 @@ drawARHUD (LocDT con _) w = fromMaybe w $ do
shineTargetLaser :: Creature -> LocationDT OItem -> World -> World
shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
guard (crIsAiming cr)
-- (_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft)
( mag) <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
i <- mag ^. dtValue . _1 . itConsumables
guard $ i >= x
maginvid <- mag ^? dtValue . _1 . itLocation . ilInvID
@@ -316,7 +315,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
, _lpType = TargetingLaser (_itID itm)
}
where
o = locOrient (loc) cr
o = locOrient loc cr
itmtree = loc ^. locDT
(p, q) = o `Q.comp` (V3 5 0 0, Q.qID)
x = 1
@@ -332,7 +331,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
shineTorch :: Creature -> LocationDT OItem -> World -> World
shineTorch cr loc = fromMaybe id $ do
( mag) <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
i <- mag ^. dtValue . _1 . itConsumables
guard $ crIsAiming cr
guard $ i >= x
@@ -342,7 +341,7 @@ shineTorch cr loc = fromMaybe id $ do
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumables . _Just -~ x)
where
itmtree = loc ^. locDT
(p, q) = locOrient (loc) cr
(p, q) = locOrient loc cr
x = 10
isammolink AmmoMagSF{} = True
isammolink _ = False
src/Dodge/Creature/Test.hs
+1 -1
View File
@@ -97,7 +97,7 @@ crInAimStance as cr = crIsAiming cr && mitstance == Just as
i <- cr ^? crManipulation . manObject . imRootSelectedItem
--itm <- invRootTrees' (cr ^. crInv) ^? ix i
itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (cr ^. crInv) ^? ix i
return $ aimStance $ itm
return $ aimStance itm
--cr ^? crInv . ix i . itUse . heldAim . aimStance
oneH :: Creature -> Bool
src/Dodge/Data/DoubleTree.hs
+8 -8
View File
@@ -113,7 +113,7 @@ makeLenses ''ContextDT
instance Functor (LocationLDT b) where
fmap f (LocLDT c t) = LocLDT (fmap f c) (fmap f t)
instance Functor (LocationDT) where
instance Functor LocationDT where
fmap f (LocDT c t) = LocDT (fmap f c) (fmap f t)
instance Functor (ContextLDT b) where
@@ -133,20 +133,20 @@ instance Functor (ContextLDT b) where
l
(fmap (fmap (fmap f)) cr)
instance Functor (ContextDT) where
instance Functor ContextDT where
fmap f = \case
TopDT -> TopDT
LeftwardDT u cl p cr fr -> LeftwardDT
(fmap f u)
(fmap (fmap ( f)) cl)
(fmap (fmap f) cl)
(f p)
(fmap (fmap ( f)) cr)
(fmap (fmap ( f)) fr)
(fmap (fmap f) cr)
(fmap (fmap f) fr)
RightwardDT u fl cl p cr -> RightwardDT (fmap f u)
(fmap (fmap ( f)) fl)
(fmap (fmap ( f)) cl)
(fmap (fmap f) fl)
(fmap (fmap f) cl)
(f p)
(fmap (fmap ( f)) cr)
(fmap (fmap f) cr)
--deriveJSON defaultOptions ''DoubleTree
--deriveJSON defaultOptions ''LabelDoubleTree
src/Dodge/DoubleTree.hs
+9 -10
View File
@@ -37,16 +37,15 @@ conLDTToConDT = \case
dtStartPropagate :: (a -> c) -> (c -> a -> c) -> DTree a -> DTree c
dtStartPropagate g f (DT x l r) = DT z
(fmap (\(t) -> (dtPropagate' z f t)) l)
(fmap (\(t) -> (dtPropagate' z f t)) r)
(fmap (dtPropagate' f z) l)
(fmap (dtPropagate' f z) r)
where
z = g x
dtPropagate' :: c -> (c -> a -> c) -> DTree a -> DTree c
dtPropagate' x f (DT y l r) = DT z
(fmap (\(t) -> (dtPropagate' z f t)) l)
(fmap (\(t) -> (dtPropagate' z f t)) r)
dtPropagate' :: (c -> a -> c) -> c -> DTree a -> DTree c
dtPropagate' f x (DT y l r) = DT z
(fmap (dtPropagate' f z) l)
(fmap (dtPropagate' f z) r)
where
z = f x y
@@ -291,12 +290,12 @@ locUp' (LocDT c@LeftwardDT{} t) =
Just $
LocDT
(_cdtUp c)
(DT (_cdtParent c) (_cdtCloseLeft c ++ (( t) : _cdtCloseRight c)) (_cdtFarRight c))
(DT (_cdtParent c) (_cdtCloseLeft c ++ ( t : _cdtCloseRight c)) (_cdtFarRight c))
locUp' (LocDT c@RightwardDT{} t) =
Just $
LocDT
(_cdtUp c)
(DT (_cdtParent c) (_cdtFarLeft c) (_cdtCloseLeft c ++ (( t) : _cdtCloseRight c)))
(DT (_cdtParent c) (_cdtFarLeft c) (_cdtCloseLeft c ++ ( t : _cdtCloseRight c)))
locToTop' :: LocationDT a -> LocationDT a
locToTop' loc = maybe loc locToTop' $ locUp' loc
@@ -333,7 +332,7 @@ locDTGoLeft (LocDT c (DT v l r)) =
-- should probably do tests for these
locDTGoRight :: LocationDT a -> [LocationDT a]
locDTGoRight (LocDT c (DT v l r)) =
[LocDT (RightwardDT c l closel v closer) t | (closel, ( t), closer) <- locDTGoHelp id r]
[LocDT (RightwardDT c l closel v closer) t | (closel, t, closer) <- locDTGoHelp id r]
-- this seems like it might be very inefficient for large lists
-- difference lists?
src/Dodge/HeldUse.hs
+21 -21
View File
@@ -69,19 +69,19 @@ hammerCheck ::
World
hammerCheck f pt loc cr w = case itemTriggerType loc of
WarmUpNoDelay wm
| _wTime (_itParams $ it) < wm ->
| _wTime (_itParams it) < wm ->
w & setwarming
& soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ it ^. itType) (Just 2)
& cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1
WarmUpNoDelay{} -> f loc cr w & setwarming
WarmUpCoolDown ws _ _
-- UNSAFE:
| _wTime (_itParams $ it) < ws ->
| _wTime (_itParams it) < ws ->
w & setwarming
& soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ it ^. itType) (Just 2)
& cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1
WarmUpCoolDown _ cs _
| _wTime (_itParams $ it) < cs ->
| _wTime (_itParams it) < cs ->
f loc cr w & setwarming
& cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1
WarmUpCoolDown{} -> w & setwarming
@@ -671,7 +671,7 @@ loadMuzzle ::
loadMuzzle t@(DT _ l _) mz = fromMaybe (t, Nothing) $ do
let as = _mzAmmoSlot mz
amamount = _mzAmmoPerShot mz
(i, ( mag)) <- findWithIx (isAmmoIntLink as . (^. dtValue . _2)) l
(i, mag) <- findWithIx (isAmmoIntLink as . (^. dtValue . _2)) l
availableammo <- mag ^. dtValue . _1 . itConsumables
let usedammo = case amamount of
UseUpTo x -> min x availableammo
@@ -681,7 +681,7 @@ loadMuzzle t@(DT _ l _) mz = fromMaybe (t, Nothing) $ do
guard $ usedammo > 0
return
( t & dtLeft . ix i . dtValue . _1 . itConsumables . _Just -~ usedammo
, Just (mz, usedammo, (mag))
, Just (mz, usedammo, mag)
)
makeMuzzleFlare :: Muzzle -> LocationDT OItem -> Creature -> World -> World
@@ -771,9 +771,9 @@ useLoadedAmmo loc cr (_, w) (Just (mz, x, magtree)) = (,) True $
MuzzleGLauncher ->
createProjectile
(itmtree ^. dtValue . _3)
(Grenade (getGrenadeHitEffect $ itmtree))
(Grenade (getGrenadeHitEffect itmtree))
magtree
(getPJStabiliser $ itmtree)
(getPJStabiliser itmtree)
mz
cr
w
@@ -933,14 +933,14 @@ getBulletType magtree =
bpayload = fromMaybe (BulPlain 100) $ do
attree <- find ispayload (magtree ^. dtLeft)
attree ^? dtValue . _1 . itUse . ubMod . bmPayload
ispayload :: (DTree OItem) -> Bool
ispayload :: DTree OItem -> Bool
ispayload y = case y ^. dtValue . _2 of
AmmoPayloadSF {} -> True
_ -> False
beffect = fromMaybe DestroyBullet $ do
attree <- find isammoeffect (magtree ^. dtLeft)
attree ^? dtValue . _1 . itUse . ubMod . bmEffect
isammoeffect :: (DTree OItem) -> Bool
isammoeffect :: DTree OItem -> Bool
isammoeffect y = case y ^. dtValue . _2 of
AmmoEffectSF {} -> True
_ -> False
@@ -984,7 +984,7 @@ shootBullets ::
World ->
World
shootBullets loc cr (mz, x, magtree) w = fromMaybe w $ do
thebullet <- getBulletType $ magtree
thebullet <- getBulletType magtree
return $ foldl' (&) w (replicate x (shootBullet thebullet loc cr mz))
shootBullet :: Bullet -> LocationDT OItem -> Creature -> Muzzle -> World -> World
@@ -1246,19 +1246,19 @@ determineProjectileTracking magtree itmtree =
_ <- find isammotargeting (magtree ^. dtLeft)
targetingtree <- find isweapontargeting (itmtree ^. dtRight)
return $ HomeUsingTargeting (targetingtree ^. dtValue . _1 . itID)
isremscreen :: (DTree OItem) -> Bool
isremscreen :: DTree OItem -> Bool
isremscreen x = case x ^. dtValue . _2 of
RemoteScreenSF {} -> True
_ -> False
isjoystick :: (DTree OItem) -> Bool
isjoystick :: DTree OItem -> Bool
isjoystick x = case x ^. dtValue . _2 of
JoystickSF {} -> True
_ -> False
isammotargeting :: (DTree OItem) -> Bool
isammotargeting :: DTree OItem -> Bool
isammotargeting x = case x ^. dtValue . _2 of
AmmoTargetingSF {} -> True
_ -> False
isweapontargeting :: (DTree OItem) -> Bool
isweapontargeting :: DTree OItem -> Bool
isweapontargeting x = case x ^. dtValue . _2 of
WeaponTargetingSF {} -> True
_ -> False
@@ -1274,7 +1274,7 @@ createProjectileR loc magtree =
createProjectile
(loc ^. locDT . dtValue . _3)
( Rocket
(determineProjectileTracking ( magtree) $ itmtree)
(determineProjectileTracking magtree itmtree)
smoke
)
magtree
@@ -1284,7 +1284,7 @@ createProjectileR loc magtree =
smoke
| isJust $ find issmokereducer (magtree ^. dtLeft) = Just ReducedRocketSmoke
| otherwise = Nothing
issmokereducer :: (DTree OItem) -> Bool
issmokereducer :: DTree OItem -> Bool
issmokereducer y = case y ^. dtValue . _2 of
SmokeReducerSF {} -> True
_ -> False
@@ -1297,7 +1297,7 @@ getPJStabiliser ldt = case find isprojstab (ldt ^. dtRight) of
_ -> Nothing
_ -> Nothing
where
isprojstab :: (DTree OItem) -> Bool
isprojstab :: DTree OItem -> Bool
isprojstab y = case y ^.dtValue . _2 of
ProjectileStabiliserSF {} -> True
_ -> False
@@ -1309,7 +1309,7 @@ getGrenadeHitEffect t = case find isghiteff (t ^. dtRight) of
_ -> GBounce 2
_ -> GBounce 2
where
isghiteff :: (DTree OItem) -> Bool
isghiteff :: DTree OItem -> Bool
isghiteff y = case y ^. dtValue . _2 of
GrenadeHitEffectSF {} -> True
_ -> False
@@ -1340,15 +1340,15 @@ createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do
createShell x rdetonate rscreen stab pjtype aparams muz cr
. startthesound
where
isrdet :: (DTree OItem) -> Bool
isrdet :: DTree OItem -> Bool
isrdet y = case y ^. dtValue . _2 of
RemoteDetonatorSF {} -> True
_ -> False
isrscreen :: (DTree OItem) -> Bool
isrscreen :: DTree OItem -> Bool
isrscreen y = case y ^. dtValue . _2 of
RemoteScreenSF {} -> True
_ -> False
isampay :: (DTree OItem) -> Bool
isampay :: DTree OItem -> Bool
isampay y = case y ^. dtValue . _2 of
AmmoPayloadSF {} -> True
_ -> False
src/Dodge/Item/Draw.hs
+1 -1
View File
@@ -23,7 +23,7 @@ itemEquipPict cr itmtree
, Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip
= equipPosition esite cr attachpos (itemSPic itm)
| itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem
= overPosSP (Q.prePos $ handHandleOrient (loc) cr) (itemTreeSPic $ itmtree)
= overPosSP (Q.prePos $ handHandleOrient loc cr) (itemTreeSPic itmtree)
| otherwise = mempty
where
itm = itmtree ^. dtValue . _1
src/Dodge/Item/Grammar.hs
+8 -22
View File
@@ -1,15 +1,12 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Item.Grammar (
invDT,
-- invLDT,
invDT',
invAdj,
invRootMap,
-- invRootTrees,
invIMDT,
baseCI,
invIndents,
-- allInvLocs,
) where
import Dodge.Item.Orientation
@@ -52,15 +49,6 @@ tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine
-- [(JoystickSF, JoystickLink)]
-- _ -> []
--itemToBreakLists ::
-- Item ->
-- ItemStructuralFunction ->
-- ([(ItemStructuralFunction, ItemLink)], [(ItemStructuralFunction, ItemLink)])
--itemToBreakLists itm itmf = (fmap f l, fmap f r)
-- where
-- f x = (x, SFLink x)
-- (l,r) = itemToBreakLists' itm itmf
itemToBreakLists ::
Item ->
ItemStructuralFunction ->
@@ -71,7 +59,7 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
(_, HeldPlatformSF) ->
( getAmmoLinks itm
<> extraWeaponLinksBelow itm
, [(WeaponTargetingSF), (WeaponScopeSF)]
, [WeaponTargetingSF, WeaponScopeSF]
<> getAutoSpringLinks itm
<> extraWeaponLinks itm
)
@@ -79,23 +67,23 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
( getAmmoLinks itm,[])
(DETECTOR {}, _) ->
( getAmmoLinks itm
, [(ARHUDSF),(TriggerSF),(MapperSF)]
, [ARHUDSF,TriggerSF,MapperSF]
)
(CRAFT TRANSFORMER, _) -> ([],[(LaserWeaponSF)])
(CRAFT TRANSFORMER, _) -> ([],[LaserWeaponSF])
(MAPPER, _) ->
( []
, [(ARHUDSF)]
, [ARHUDSF]
)
(_, GadgetPlatformSF) ->
( getAmmoLinks itm
, [(TriggerSF), (WeaponTargetingSF), (WeaponScopeSF)]
, [TriggerSF, WeaponTargetingSF, WeaponScopeSF]
)
(_, AmmoMagSF{}) -> fromMaybe ([], []) $ do
atype <- magAmmoType itm
let screenanddet = case atype of
LauncherAmmo ->
[ (RemoteScreenSF)
, (RemoteDetonatorSF)
[ RemoteScreenSF
, RemoteDetonatorSF
]
_ -> []
return
@@ -133,9 +121,7 @@ extraWeaponLinks itm = case itm ^. itType of
extraWeaponLinksBelow :: Item -> [(ItemStructuralFunction)]
extraWeaponLinksBelow itm
-- | Just TwoHandUnder <- itm ^? itUse . heldAim . aimStance
| TwoHandUnder <- itemBaseStance itm
= [(UnderBarrelSlotSF)]
| TwoHandUnder <- itemBaseStance itm = [(UnderBarrelSlotSF)]
| otherwise = []
getAmmoLinks :: Item -> [(ItemStructuralFunction)]
src/Dodge/WorldEffect.hs
+1 -1
View File
@@ -47,7 +47,7 @@ doWdWd we = case we of
cr <- w ^? cWorld . lWorld . creatures . ix cid
--itree <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT
loc <- invIndents (cr ^. crInv) ^? ix invid . _2
return $ heldEffectMuzzles (loc) cr w
return $ heldEffectMuzzles loc cr w
accessTerminal :: Maybe Int -> World -> World
accessTerminal mtmid w = fromMaybe w $ do