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

Simplify item composition structure

Browse Source
This commit is contained in:
justin
2025-06-26 21:07:11 +01:00
parent 758c0aeec8
commit 377900662a
9 changed files with 195 additions and 208 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/UseItem.hs
+2 -2
View File
@@ -33,13 +33,13 @@ useItemLoc cr loc pt w
| HeldPlatformSF <- sf
, fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsRoot
, Aiming {} <- cr ^. crStance . posture =
return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
return $ heldEffect pt (bimap id (^. _1) ldt) cr w
| GadgetPlatformSF <- sf =
return $ gadgetEffect pt loc cr w
| UnderBarrelPlatformSF <- sf
, fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
, Aiming {} <- cr ^. crStance . posture =
return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
return $ heldEffect pt (bimap id (^. _1) ldt) cr w
| RemoteDetonatorSF <- sf
, pt == InitialPress =
return $ activateDetonator ldt w
src/Dodge/Creature/State.hs
+4 -4
View File
@@ -216,7 +216,7 @@ doAnyEquipmentEffect loc cr = case itm ^? itLocation . ilEquipSite . _Just of
tryUseParent :: LocationLDT ItemLink CItem -> World -> World
tryUseParent loc w = fromMaybe w $ do
t <- locUp loc
let t' = bimap (^. iatType) (^. _1) $ t ^. locLDT
let t' = bimap id (^. _1) $ t ^. locLDT
cr <- w ^? cWorld . lWorld . creatures . ix 0
return $ heldEffectNoHammerCheck t' cr w
@@ -295,7 +295,7 @@ chainLinkOrientation ::
ItemLink ->
CItem ->
(Point3, Q.Quaternion Float)
chainLinkOrientation (p, q) par (ILink lt) child = (p + Q.rotate q p1, q * q1)
chainLinkOrientation (p, q) par lt child = (p + Q.rotate q p1, q * q1)
where
(p1, q1) = orientAttachment (par ^. _1) lt (child ^. _1)
@@ -332,7 +332,7 @@ shineTargetLaser ::
World
shineTargetLaser cr itmtree (p, q) w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
guard (crIsAiming cr)
(_, mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
(_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft)
i <- mag ^. ldtValue . _1 . itConsumables
guard $ i >= x
maginvid <- mag ^? ldtValue . _1 . itLocation . ilInvID
@@ -372,7 +372,7 @@ shineTorch ::
World ->
World
shineTorch cr itmtree (p, q) = fromMaybe id $ do
(_, mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
(_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft)
i <- mag ^. ldtValue . _1 . itConsumables
guard $ crIsAiming cr
guard $ i >= x
src/Dodge/Data/ComposedItem.hs
+1 -8
View File
@@ -10,7 +10,7 @@ import Dodge.Data.DoubleTree
import Control.Lens
import Dodge.Data.Item
data CLinkType
data ItemLink
= AmmoInLink Int AmmoType
| TriggerLink
| AmmoModLink
@@ -65,12 +65,6 @@ data ItemStructuralFunction
type CItem = (Item, ItemStructuralFunction, LinkTest)
data ItemLink = ILink
{ _iatType :: CLinkType
-- , _iatOrient :: Item -> CLinkType -> Item -> (Point3, Quaternion Float)
-- , _iatOrient :: Item -> CLinkType -> (Point3, Quaternion Float)
}
-- this should possibly use a full item structure tree rather than a
-- CItem as arguments
data LinkTest = LTest
@@ -87,6 +81,5 @@ data LinkUpdate = LUpdate
makeLenses ''ItemLink
makeLenses ''LinkTest
makeLenses ''LinkUpdate
makeLenses ''CLinkType
--deriveJSON defaultOptions ''ItemStructuralFunction
--deriveJSON defaultOptions ''ComposeLinkType
src/Dodge/HeldUse.hs
+30 -30
View File
@@ -50,7 +50,7 @@ gadgetEffect pt loc
| UseHeld{} <- loc ^. locLDT . ldtValue . _1 . itUse =
heldEffect
pt
(bimap _iatType (^. _1) (loc ^. locLDT))
(bimap id (^. _1) (loc ^. locLDT))
| DROPPER x <- loc ^. locLDT . ldtValue . _1 . itType
, Just i <- loc ^? locLDT . ldtValue . _1 . itUse . uInt
, pt == InitialPress =
@@ -60,23 +60,23 @@ gadgetEffect pt loc
useInventoryPath pt i x loc
| otherwise = const id
heldEffect :: PressType -> LabelDoubleTree CLinkType Item -> Creature -> World -> World
heldEffect :: PressType -> LabelDoubleTree ItemLink Item -> Creature -> World -> World
heldEffect = useTimeCheck . hammerCheck heldEffectMuzzles
heldEffectNoHammerCheck :: LabelDoubleTree CLinkType Item -> Creature -> World -> World
heldEffectNoHammerCheck :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
heldEffectNoHammerCheck = useTimeCheck heldEffectMuzzles
type ChainEffect =
(LabelDoubleTree CLinkType Item -> Creature -> World -> World) ->
LabelDoubleTree CLinkType Item ->
(LabelDoubleTree ItemLink Item -> Creature -> World -> World) ->
LabelDoubleTree ItemLink Item ->
Creature ->
World ->
World
hammerCheck ::
(LabelDoubleTree CLinkType Item -> Creature -> World -> World) ->
(LabelDoubleTree ItemLink Item -> Creature -> World -> World) ->
PressType ->
LabelDoubleTree CLinkType Item ->
LabelDoubleTree ItemLink Item ->
Creature ->
World ->
World
@@ -142,7 +142,7 @@ useTimeCheck f item cr w = case useDelay $ item ^. ldtValue of
-- will have problems elsewhere also
itRef = item ^?! ldtValue . itLocation . ilInvID
heldEffectMuzzles :: LabelDoubleTree CLinkType Item -> Creature -> World -> World
heldEffectMuzzles :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
heldEffectMuzzles t cr w =
setusetime . doHeldUseEffect t cr
. uncurry (applyCME (_ldtValue t) cr)
@@ -336,7 +336,7 @@ vgunMuzzles i =
-- <*> ZipList [0 .. i -1]
)
doHeldUseEffect :: LabelDoubleTree CLinkType Item -> Creature -> World -> World
doHeldUseEffect :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
doHeldUseEffect t cr w = case t ^. ldtValue . itType of
HELD (VOLLEYGUN j) -> case itm ^? itParams . unfiredBarrels of
Just [_] -> fromMaybe w $ do
@@ -677,9 +677,9 @@ heldTorqueAmount = \case
-- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
loadMuzzle ::
LabelDoubleTree CLinkType Item ->
LabelDoubleTree ItemLink Item ->
Muzzle ->
(LabelDoubleTree CLinkType Item, Maybe (Muzzle, Int, LabelDoubleTree CLinkType Item))
(LabelDoubleTree ItemLink Item, Maybe (Muzzle, Int, LabelDoubleTree ItemLink Item))
loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do
-- guard $ mz ^? mzFrame == t ^? ldtValue . itUse . heldFrame
let as = _mzAmmoSlot mz
@@ -697,7 +697,7 @@ loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do
, Just (mz, usedammo, mag)
)
makeMuzzleFlare :: Muzzle -> LabelDoubleTree CLinkType Item -> Creature -> World -> World
makeMuzzleFlare :: Muzzle -> LabelDoubleTree ItemLink Item -> Creature -> World -> World
makeMuzzleFlare mz itmtree cr = case mz ^. mzFlareType of
NoFlare -> id
BasicFlare -> basicMuzFlare pos dir
@@ -746,13 +746,13 @@ flareCircleAt col alphax tranv =
)
-- previous phaseV parameters: 0.2, 1, 5
getLaserPhaseV :: LabelDoubleTree CLinkType Item -> Float
getLaserPhaseV :: LabelDoubleTree ItemLink Item -> Float
getLaserPhaseV = const 1
getLaserDamage :: LabelDoubleTree CLinkType Item -> LaserType
getLaserDamage :: LabelDoubleTree ItemLink Item -> LaserType
getLaserDamage = const (DamageLaser 11)
getLaserColor :: LabelDoubleTree CLinkType Item -> Color
getLaserColor :: LabelDoubleTree ItemLink Item -> Color
getLaserColor = const yellow
basicMuzFlare :: Point2 -> Float -> World -> World
@@ -762,15 +762,15 @@ basicMuzFlare pos dir =
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
isAmmoIntLink :: Int -> CLinkType -> Bool
isAmmoIntLink :: Int -> ItemLink -> Bool
isAmmoIntLink i (AmmoInLink j _) = i == j
isAmmoIntLink _ _ = False
useLoadedAmmo ::
LabelDoubleTree CLinkType Item ->
LabelDoubleTree ItemLink Item ->
Creature ->
(Bool, World) ->
Maybe (Muzzle, Int, LabelDoubleTree CLinkType Item) ->
Maybe (Muzzle, Int, LabelDoubleTree ItemLink Item) ->
(Bool, World)
useLoadedAmmo _ _ (cme, w) Nothing = (cme, w)
useLoadedAmmo itmtree cr (_, w) (Just (mz, x, magtree)) = (,) True $
@@ -808,7 +808,7 @@ useLoadedAmmo itmtree cr (_, w) (Just (mz, x, magtree)) = (,) True $
getAttachedSFLink ::
ItemStructuralFunction ->
LabelDoubleTree CLinkType Item ->
LabelDoubleTree ItemLink Item ->
Maybe (NewInt ItmInt)
getAttachedSFLink sf = (^? ldtRight . folding (lookup (SFLink sf)) . ldtValue . itID)
@@ -869,7 +869,7 @@ tractorBeamAt pos outpos dir power =
d = unitVectorAtAngle dir * power
creatureShootLaser ::
LabelDoubleTree CLinkType Item ->
LabelDoubleTree ItemLink Item ->
Creature ->
Muzzle ->
World ->
@@ -925,7 +925,7 @@ removeAmmoFromMag x mid cr = fromMaybe id $ do
. _Just
-~ x
getBulletType :: LabelDoubleTree CLinkType Item -> Maybe Bullet
getBulletType :: LabelDoubleTree ItemLink Item -> Maybe Bullet
getBulletType magtree =
--magtree ^? ldtValue . itConsumables . magParams . ampBullet
(magtree ^? ldtValue >>= magAmmoParams >>= (^? ampBullet))
@@ -979,9 +979,9 @@ magAmmoParams itm = case itm ^. itType of
-- _ -> 0
shootBullet ::
LabelDoubleTree CLinkType Item ->
LabelDoubleTree ItemLink Item ->
Creature ->
(Muzzle, Int, LabelDoubleTree CLinkType Item) ->
(Muzzle, Int, LabelDoubleTree ItemLink Item) ->
World ->
World
shootBullet itmtree cr (mz, x, magtree) w = fromMaybe w $ do
@@ -1266,8 +1266,8 @@ shootTeslaArc itm cr mz w =
dir = _crDir cr + mrot
determineProjectileTracking ::
LabelDoubleTree CLinkType Item ->
LabelDoubleTree CLinkType Item ->
LabelDoubleTree ItemLink Item ->
LabelDoubleTree ItemLink Item ->
RocketHoming
determineProjectileTracking magtree itmtree =
fromMaybe NoHoming $
@@ -1283,8 +1283,8 @@ determineProjectileTracking magtree itmtree =
return $ HomeUsingTargeting (targetingtree ^. ldtValue . itID)
createProjectileR ::
LabelDoubleTree CLinkType Item ->
LabelDoubleTree CLinkType Item ->
LabelDoubleTree ItemLink Item ->
LabelDoubleTree ItemLink Item ->
Muzzle ->
Creature ->
World ->
@@ -1302,7 +1302,7 @@ createProjectileR itmtree magtree =
| isJust $ lookup SmokeReducerLink (magtree ^. ldtLeft) = Just ReducedRocketSmoke
| otherwise = Nothing
getPJStabiliser :: LabelDoubleTree CLinkType Item -> Maybe PJStabiliser
getPJStabiliser :: LabelDoubleTree ItemLink Item -> Maybe PJStabiliser
getPJStabiliser ldt = case lookup ProjectileStabiliserLink (ldt ^. ldtRight) of
Just ldt' -> case ldt' ^? ldtValue . itType . ibtAttach of
Just GIMBAL -> Just StabOrthReduce
@@ -1310,7 +1310,7 @@ getPJStabiliser ldt = case lookup ProjectileStabiliserLink (ldt ^. ldtRight) of
_ -> Nothing
_ -> Nothing
getGrenadeHitEffect :: LabelDoubleTree CLinkType Item -> GrenadeHitEffect
getGrenadeHitEffect :: LabelDoubleTree ItemLink Item -> GrenadeHitEffect
getGrenadeHitEffect t = case lookup GrenadeHitEffectLink (t ^. ldtRight) of
Just ldt' -> case ldt' ^? ldtValue . itType of
Just STICKYMOD -> GStick
@@ -1319,7 +1319,7 @@ getGrenadeHitEffect t = case lookup GrenadeHitEffectLink (t ^. ldtRight) of
createProjectile ::
ProjectileType ->
LabelDoubleTree CLinkType Item ->
LabelDoubleTree ItemLink Item ->
Maybe PJStabiliser ->
Muzzle ->
Creature ->
src/Dodge/Item/Draw/SPic.hs
+1 -1
View File
@@ -29,7 +29,7 @@ itemTreeSPic (LDT (itm,_,_) l r) =
itemRotTreeSPic :: Item -> (ItemLink, LabelDoubleTree ItemLink CItem) -> SPic
itemRotTreeSPic par (il, t) = translateSP p . overPosSP (Q.rotate q) $ itemTreeSPic t
where
(p, q) = orientAttachment par (_iatType il) itm
(p, q) = orientAttachment par il itm
itm = t ^. ldtValue . _1
itemSPic :: Item -> SPic
src/Dodge/Item/Grammar.hs
+10 -10
View File
@@ -34,12 +34,12 @@ tryAttachItems ::
tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine
useBreakL ::
[(ItemStructuralFunction, CLinkType)] ->
[(ItemStructuralFunction, CLinkType)] ->
[(ItemStructuralFunction, ItemLink)] ->
[(ItemStructuralFunction, ItemLink)] ->
LinkTest
useBreakL x y = useBreakListsLinkTest (map (uncurry noa) x) (map (uncurry noa) y)
where
noa a b = (a, ILink b)
noa a b = (a, b)
useBreakListsLinkTest ::
[(ItemStructuralFunction, ItemLink)] ->
@@ -67,7 +67,7 @@ useBreakListsLinkTest llist rlist = LTest ltest rtest
itemToBreakLists ::
Item ->
ItemStructuralFunction ->
([(ItemStructuralFunction, CLinkType)], [(ItemStructuralFunction, CLinkType)])
([(ItemStructuralFunction, ItemLink)], [(ItemStructuralFunction, ItemLink)])
itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
(HELD TORCH, _) -> (getAmmoLinks itm, [])
(ATTACH UNDERBARRELSLOT, _) -> ([(UnderBarrelPlatformSF, UnderBarrelPlatformLink)], [])
@@ -117,12 +117,12 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
([(AmmoMagSF ElectricalAmmo, AmmoInLink 0 ElectricalAmmo)], [])
_ -> ([], [])
getAutoSpringLinks :: Item -> [(ItemStructuralFunction, CLinkType)]
getAutoSpringLinks :: Item -> [(ItemStructuralFunction, ItemLink)]
getAutoSpringLinks itm = case itemTriggerType itm of
HammerTrigger -> [(MakeAutoSF, MakeAutoLink)]
_ -> []
extraWeaponLinks :: Item -> [(ItemStructuralFunction, CLinkType)]
extraWeaponLinks :: Item -> [(ItemStructuralFunction, ItemLink)]
extraWeaponLinks itm = case itm ^. itType of
HELD GLAUNCHER -> launcherlinks <> [(GrenadeHitEffectSF,GrenadeHitEffectLink)]
HELD RLAUNCHER -> launcherlinks
@@ -131,14 +131,14 @@ extraWeaponLinks itm = case itm ^. itType of
where
launcherlinks = [(ProjectileStabiliserSF,ProjectileStabiliserLink)]
extraWeaponLinksBelow :: Item -> [(ItemStructuralFunction, CLinkType)]
extraWeaponLinksBelow :: Item -> [(ItemStructuralFunction, ItemLink)]
extraWeaponLinksBelow itm
-- | Just TwoHandUnder <- itm ^? itUse . heldAim . aimStance
| TwoHandUnder <- itemBaseStance itm
= [(UnderBarrelSlotSF,UnderBarrelSlotLink)]
| otherwise = []
getAmmoLinks :: Item -> [(ItemStructuralFunction, CLinkType)]
getAmmoLinks :: Item -> [(ItemStructuralFunction, ItemLink)]
getAmmoLinks itm =
map
(\(i, a) -> (AmmoMagSF a, AmmoInLink i a))
@@ -215,7 +215,7 @@ llright itm pci = case pci ^. ldtValue . _1 . itType of
toLasgunUpdate :: Item -> LinkUpdate
toLasgunUpdate itm =
LUpdate
(ILink FunctionChangeLink)
FunctionChangeLink
(\(par, _, _) -> (par, HeldPlatformSF, uncurry useBreakL $ itemToBreakLists itm HeldPlatformSF))
(\(chi, _, up) -> (chi, FunctionChangeSF, up))
@@ -225,7 +225,7 @@ springLinkTest = LTest (const Nothing) $
CRAFT HARDWARE ->
Just
( LUpdate
(ILink FunctionChangeLink)
(FunctionChangeLink)
(\(par, _, up) -> (par, MakeAutoSF, up))
(\(chi, _, up) -> (chi, FunctionChangeSF, up))
)
src/Dodge/Item/Orientation.hs
+2 -2
View File
@@ -13,14 +13,14 @@ orientChild itm = case _itType itm of
HELD LASER -> (V3 15 (-5) 0, Q.qID)
_ -> (0, Q.qID)
orientByLink :: Item -> CLinkType -> (Point3, Q.Quaternion Float)
orientByLink :: Item -> ItemLink -> (Point3, Q.Quaternion Float)
orientByLink itm lt = case (_itType itm, lt) of
(HELD FLAMETHROWER, AmmoInLink{}) -> (V3 4 (-6) 0, Q.qID)
(HELD _, AmmoInLink{}) -> (V3 7 (-2) 0, Q.qID)
(HELD _, WeaponScopeLink) -> (V3 5 0 5, Q.qID)
_ -> (0, Q.qID)
orientAttachment :: Item -> CLinkType -> Item -> (Point3, Q.Quaternion Float)
orientAttachment :: Item -> ItemLink -> Item -> (Point3, Q.Quaternion Float)
orientAttachment par lnk ch = case (_itType par, lnk, _itType ch) of
-- (HELD BURSTRIFLE, _, HELD TORCH) -> (V3 20 0 0, Q.axisAngle (V3 0 0 1) (pi/2))
-- (HELD LAUNCHER, _, HELD TORCH) -> (V3 0 20 0, Q.axisAngle (V3 0 0 1) (pi/4))
src/Dodge/WorldEffect.hs
+1 -3
View File
@@ -8,9 +8,7 @@ module Dodge.WorldEffect (
import Dodge.Item.Grammar
import Dodge.Creature.Impulse.UseItem
import Dodge.BlBl
--import Dodge.Data.Input
import Dodge.HeldUse
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Data.Foldable
import qualified Data.Map.Strict as M
@@ -47,7 +45,7 @@ doWdWd we = case we of
UseInvItem invid pt -> \w -> fromMaybe w (useItem invid pt w)
WdWdBurstFireRepetition cid invid -> \w -> fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix cid
itree <- bimap _iatType (^. _1) <$>
itree <- bimap id (^. _1) <$>
allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT
return $ heldEffectMuzzles itree cr w