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

Remove LDTs from item attachment

Browse Source
This commit is contained in:
justin
2025-07-12 21:21:37 +01:00
parent 264d83971f
commit 5544e891c5
2 changed files with 57 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Grammar.hs
+42 -43
View File
@@ -33,8 +33,7 @@ import Dodge.DoubleTree
import LensHelp
import ListHelp
tryAttachItems :: LDTree ItemLink CItem -> LDTree ItemLink CItem ->
Maybe (LDTree ItemLink CItem)
tryAttachItems :: DTree CItem -> DTree CItem -> Maybe (DTree CItem)
tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine
--breakListAbove :: Item -> ItemStructuralFunction -> [(ItemStructuralFunction, ItemLink)]
@@ -53,20 +52,20 @@ 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 ->
([(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 ->
([(ItemStructuralFunction)], [(ItemStructuralFunction)])
itemToBreakLists' itm itmf = case (itm ^. itType, itmf) of
itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
(HELD TORCH, _) -> (getAmmoLinks itm, [])
(ATTACH UNDERBARRELSLOT, _) -> ([(UnderBarrelPlatformSF)], [])
(_, HeldPlatformSF) ->
@@ -179,8 +178,8 @@ itemToFunction itm = case itm ^. itType of
CLICKER{} -> GadgetPlatformSF
_ -> NoSF
treeToPotentialFunction :: LDTree ItemLink CItem -> S.Set ItemStructuralFunction
treeToPotentialFunction ldt = case ldt ^. ldtValue . _1 . itType of
treeToPotentialFunction :: DTree CItem -> S.Set ItemStructuralFunction
treeToPotentialFunction ldt = case ldt ^. dtValue . _1 . itType of
STICKYMOD -> S.singleton GrenadeHitEffectSF
ATTACH GIMBAL -> S.singleton ProjectileStabiliserSF
ATTACH GYROSCOPE -> S.singleton ProjectileStabiliserSF
@@ -188,52 +187,52 @@ treeToPotentialFunction ldt = case ldt ^. ldtValue . _1 . itType of
HELD BURSTRIFLE -> S.singleton UnderBarrelPlatformSF
HELD LASER -> S.fromList [WeaponTargetingSF,LaserWeaponSF]
-- following limits items to ten ammo slots
_ | AmmoMagSF _ x <- ldt ^. ldtValue . _2 -> S.fromList [AmmoMagSF i x | i <- [0..9]]
_ -> S.singleton (ldt ^. ldtValue . _2)
_ | AmmoMagSF _ x <- ldt ^. dtValue . _2 -> S.fromList [AmmoMagSF i x | i <- [0..9]]
_ -> S.singleton (ldt ^. dtValue . _2)
baseCI :: Item -> CItem
baseCI itm = (itm, itemToFunction itm)
type LDTComb a b = LDTree b a -> LDTree b a -> Maybe (LDTree b a)
type DTComb a = DTree a -> DTree a -> Maybe (DTree a)
leftIsParentCombine :: LDTComb CItem ItemLink
leftIsParentCombine :: DTComb CItem
leftIsParentCombine ltree rtree = do
let l = rightChildList ltree
xs = dropWhile ((\s -> not $ S.member s (treeToPotentialFunction rtree)) . fst) l
(sf,linktype) <- safeHead xs
return $ ltree & ldtRight .:~ (linktype, rtree & ldtValue . _2 .~ sf)
xs = dropWhile ((\s -> not $ S.member s (treeToPotentialFunction rtree))) l
(sf) <- safeHead xs
return $ ltree & dtRight .:~ ( rtree & dtValue . _2 .~ sf)
rightIsParentCombine :: LDTComb CItem ItemLink
rightIsParentCombine :: DTComb CItem
rightIsParentCombine ltree rtree = do
let l = leftChildList rtree
xs = dropWhile ((\s -> not $ S.member s (treeToPotentialFunction ltree)) . fst) l
(sf,linktype) <- safeHead xs
return $ rtree & ldtLeft .:~ (linktype, ltree & ldtValue . _2 .~ sf)
xs = dropWhile ((\s -> not $ S.member s (treeToPotentialFunction ltree))) l
(sf) <- safeHead xs
return $ rtree & dtLeft .:~ ( ltree & dtValue . _2 .~ sf)
leftChildList :: LDTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
leftChildList t = foldl' f l (reverse $ t ^.. ldtLeft . each . _2 . ldtValue . _2)
leftChildList :: DTree CItem -> [ItemStructuralFunction]
leftChildList t = foldl' f l (reverse $ t ^.. dtLeft . each . dtValue . _2)
where
l = fst $ itemToBreakLists (t ^. ldtValue . _1) (t ^. ldtValue . _2)
f x y = tail $ dropWhile ((/=y) . fst) x
l = fst $ itemToBreakLists (t ^. dtValue . _1) (t ^. dtValue . _2)
f x y = tail $ dropWhile ((/=y) ) x
rightChildList :: LDTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
rightChildList t = foldl' f l (reverse $ t ^.. ldtRight . each . _2 . ldtValue . _2)
rightChildList :: DTree CItem -> [ItemStructuralFunction]
rightChildList t = foldl' f l (reverse $ t ^.. dtRight . each . dtValue . _2)
where
l = snd $ itemToBreakLists (t ^. ldtValue . _1) (t ^. ldtValue . _2)
f x y = tail $ dropWhile ((/=y) . fst) x
l = snd $ itemToBreakLists (t ^. dtValue . _1) (t ^. dtValue . _2)
f x y = tail $ dropWhile ((/=y)) x
leftRightCombine ::
LDTComb a b ->
LDTComb a b ->
LDTree b a ->
LDTree b a ->
Maybe (LDTree b a)
DTComb a ->
DTComb a ->
DTree a ->
DTree a ->
Maybe (DTree a)
leftRightCombine f f' t1 t2 = f t1 t2 <|> checkdepth t1 t2
where
checkdepth t t'@(LDT x ls rs) = fromMaybe (checktop t t') $ do
(lab, t'') <- safeHead ls
checkdepth t t'@(DT x ls rs) = fromMaybe (checktop t t') $ do
(t'') <- safeHead ls
tx <- checkdepth t t''
return $ Just $ LDT x ((lab, tx) : tail ls) rs
return $ Just $ DT x (( tx) : tail ls) rs
checktop t t' = f' t t'
joinItemsInList :: (a -> a -> Maybe a) -> [a] -> [a]
@@ -252,9 +251,9 @@ joinItemsInList f = fst . h . ([],)
-- . fmap (singleLDT . baseCI)
invDT :: IM.IntMap Item -> [DTree CItem]
invDT = fmap ldtToDT .
invDT =
joinItemsInList tryAttachItems . IM.elems
. fmap (singleLDT . baseCI)
. fmap (singleDT . baseCI)
--invLDT' :: IM.IntMap Item -> [LDTree ItemLink OItem]
--invLDT' = fmap propagateOrientation . invLDT