Cleanup LabelDoubleTree -> LDTree

2025-06-27 08:55:00 +01:00
parent 73c708a325
commit dd5a747559
11 changed files with 101 additions and 218 deletions
@@ -10,7 +10,7 @@ import Dodge.Data.AimStance
 --aStance :: LocationLDT ItemLink CItem -> AimStance
 --aStance loc = case loc ^. locLDT . ldtValue . _1 . itType of
 --
-aimStance :: LabelDoubleTree ItemLink CItem -> AimStance
+aimStance :: LDTree ItemLink CItem -> AimStance
 aimStance ldt = itemBaseStance $ ldt ^. ldtValue . _1


@@ -15,7 +15,7 @@ import Dodge.Item.Draw.SPic
 import Dodge.Item.HeldOffset
 import ShapePicture

-itemEquipPict :: Creature -> LabelDoubleTree ItemLink CItem -> SPic
+itemEquipPict :: Creature -> LDTree ItemLink CItem -> SPic
 itemEquipPict cr itmtree
    | Just i <- itm ^? itLocation . ilInvID
    , Just esite <- cr ^? crInv . ix i . itLocation . ilEquipSite . _Just
@@ -21,12 +21,10 @@ import Picture
 import Shape
 import ShapePicture

-itemTreeSPic :: LabelDoubleTree ItemLink CItem -> SPic
-itemTreeSPic (LDT (itm,_,_) l r) =
-    itemSPic itm
-        <> foldMap (itemRotTreeSPic itm) (l <> r)
+itemTreeSPic :: LDTree ItemLink CItem -> SPic
+itemTreeSPic (LDT (itm,_) l r) = itemSPic itm <> foldMap (itemRotTreeSPic itm) (l <> r)

-itemRotTreeSPic :: Item -> (ItemLink, LabelDoubleTree ItemLink CItem) -> SPic
+itemRotTreeSPic :: Item -> (ItemLink, LDTree ItemLink CItem) -> SPic
 itemRotTreeSPic par (il, t) = translateSP p . overPosSP (Q.rotate q) $ itemTreeSPic t
  where
    (p, q) = orientAttachment par il itm
@@ -27,35 +27,10 @@ import Dodge.DoubleTree
 import LensHelp
 import ListHelp

-tryAttachItems ::
-    LabelDoubleTree ItemLink CItem ->
-    LabelDoubleTree ItemLink CItem ->
-    Maybe (LabelDoubleTree ItemLink CItem)
+tryAttachItems :: LDTree ItemLink CItem -> LDTree ItemLink CItem -> 
+    Maybe (LDTree ItemLink CItem)
 tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine

-useBreakL ::
-    [(ItemStructuralFunction, ItemLink)] ->
-    [(ItemStructuralFunction, ItemLink)] ->
-    LinkTest
-useBreakL llist rlist = LTest ltest rtest
-  where
-    ltest ldt = do
-        let xs =
-                dropWhile
-                    ((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
-                    llist
-        (sf, linktype) <- safeHead xs
-        return $ LUpdate linktype (set _3 (useBreakL (tail xs) rlist)) 
-            (_2 .~ sf)
-    rtest ldt = do
-        let xs =
-                dropWhile
-                    ((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
-                    rlist
-        (sf, linktype) <- safeHead xs
-        return $ LUpdate linktype (set _3 (useBreakL llist (tail xs))) 
-            (_2 .~ sf)
-
 itemToBreakLists ::
    Item ->
    ItemStructuralFunction ->
@@ -173,9 +148,7 @@ itemToFunction itm = case itm ^. itType of
    CLICKER{} -> GadgetPlatformSF
    _ -> NoSF

-structureToPotentialFunction ::
-    LabelDoubleTree ItemLink CItem ->
-    S.Set ItemStructuralFunction
+structureToPotentialFunction :: LDTree ItemLink CItem -> S.Set ItemStructuralFunction
 structureToPotentialFunction ldt = case ldt ^. ldtValue . _1 . itType of
    STICKYMOD -> S.singleton GrenadeHitEffectSF
    ATTACH GIMBAL -> S.singleton ProjectileStabiliserSF
@@ -184,52 +157,9 @@ structureToPotentialFunction ldt = case ldt ^. ldtValue . _1 . itType of
    _ -> S.singleton (ldt ^. ldtValue . _2)

 baseCI :: Item -> CItem
-baseCI itm = (itm, itemToFunction itm, itemBaseConnections itm)
+baseCI itm = (itm, itemToFunction itm)

-itemBaseConnections :: Item -> LinkTest
-itemBaseConnections itm = case _itType itm of
-    HELD LASER -> laserLinkTest itm
-    CRAFT SPRING -> springLinkTest
-    _ -> uncurry useBreakL $ itemToBreakLists itm (itemToFunction itm)
-
-laserLinkTest :: Item -> LinkTest
-laserLinkTest itm = LTest (llleft itm) (llright itm)
-
-llleft :: Item -> LabelDoubleTree ItemLink CItem -> Maybe LinkUpdate
-llleft itm =
-    _tryLeftLink
-        . uncurry useBreakL
-        $ itemToBreakLists itm WeaponTargetingSF
-
-llright :: Item -> LabelDoubleTree ItemLink CItem -> Maybe LinkUpdate
-llright itm pci = case pci ^. ldtValue . _1 . itType of
-    CRAFT TRANSFORMER -> Just (toLasgunUpdate itm)
-    _ -> _tryRightLink (uncurry useBreakL $ itemToBreakLists itm WeaponTargetingSF) pci
-
-toLasgunUpdate :: Item -> LinkUpdate
-toLasgunUpdate itm =
-    LUpdate
-        FunctionChangeLink
-        (\(par, _, _) -> (par, HeldPlatformSF, uncurry useBreakL $ itemToBreakLists itm HeldPlatformSF))
-        (\(chi, _, up) -> (chi, FunctionChangeSF, up))
-
-springLinkTest :: LinkTest
-springLinkTest = LTest (const Nothing) $
-    \ci -> case ci ^. ldtValue . _1 . itType of
-        CRAFT HARDWARE ->
-            Just
-                ( LUpdate
-                    (FunctionChangeLink)
-                    (\(par, _, up) -> (par, MakeAutoSF, up))
-                    (\(chi, _, up) -> (chi, FunctionChangeSF, up))
-                )
-        _ -> Nothing
-
--itemLinkTestLeft :: Item -> PartiallyCItem -> Maybe LinkUpdate
--itemLinkTestLeft itm = _tryLeftLink $
--    uncurry useBreakL $ itemToBreakLists itm
-
-type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
+type LDTComb a b = LDTree b a -> LDTree b a -> Maybe (LDTree b a)

 leftIsParentCombine :: LDTComb CItem ItemLink
 leftIsParentCombine ltree rtree = do
@@ -239,13 +169,6 @@ leftIsParentCombine ltree rtree = do
    return $
        ltree & ldtRight .:~ (linktype, rtree & ldtValue . _2 .~ sf)

-leftIsParentCombine' :: LDTComb CItem ItemLink
-leftIsParentCombine' ltree rtree = do
-    lu <- (ltree ^. ldtValue . _3 . tryRightLink) rtree --(rtree ^. ldtValue)
-    return $
-        ltree & ldtValue %~ (lu ^. luParentUpdate)
-            & ldtRight %~ (++ [(lu ^. luLinkType, rtree & ldtValue %~ (lu ^. luChildUpdate))])
-
 rightIsParentCombine :: LDTComb CItem ItemLink
 rightIsParentCombine ltree rtree = do
    let l = leftChildList rtree
@@ -254,31 +177,24 @@ rightIsParentCombine ltree rtree = do
    return $
        rtree & ldtLeft .:~ (linktype, ltree & ldtValue . _2 .~ sf)

-leftChildList :: LabelDoubleTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
+leftChildList :: LDTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
 leftChildList t = foldl' f l (reverse $ t ^.. ldtLeft . each . _1)
  where
    l = fst $ itemToBreakLists (t ^. ldtValue . _1) (t ^. ldtValue . _2)
    f x y = tail $ dropWhile ((/=y) . snd) x

-rightChildList :: LabelDoubleTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
+rightChildList :: LDTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
 rightChildList t = foldl' f l (reverse $ t ^.. ldtRight . each . _1)
  where
    l = snd $ itemToBreakLists (t ^. ldtValue . _1) (t ^. ldtValue . _2)
    f x y = tail $ dropWhile ((/=y) . snd) x

-rightIsParentCombine' :: LDTComb CItem ItemLink
-rightIsParentCombine' ltree rtree = do
-    lu <- (rtree ^. ldtValue . _3 . tryLeftLink) ltree -- (ltree ^. ldtValue)
-    return $
-        rtree & ldtValue %~ (lu ^. luParentUpdate)
-            & ldtLeft .:~ (lu ^. luLinkType, ltree & ldtValue %~ (lu ^. luChildUpdate))
-
 leftRightCombine ::
    LDTComb a b ->
    LDTComb a b ->
-    LabelDoubleTree b a ->
-    LabelDoubleTree b a ->
-    Maybe (LabelDoubleTree b a)
+    LDTree b a ->
+    LDTree b a ->
+    Maybe (LDTree b 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
@@ -297,7 +213,7 @@ joinItemsInList f xs = snd $ h (xs, [])
        Just w -> h (w : ys, zs)

 -- this puts the first elements in the intmap at the end of the list
-invLDT :: IM.IntMap Item -> [LabelDoubleTree ItemLink CItem]
+invLDT :: IM.IntMap Item -> [LDTree ItemLink CItem]
 invLDT =
    joinItemsInList tryAttachItems . IM.elems
        . fmap (singleLDT . baseCI)
@@ -321,18 +237,16 @@ invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
 invAdj = IM.unions . map g . invLDT
  where
    g = dtToLRAdj getid . ldtToDT
-    getid (itm, _, _) =
+    getid (itm, _) =
        fromMaybe
            (error ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))
            $ itm ^? itLocation . ilInvID

 -- returns an intmap with trees for (only!) root items, indexed by inventory position
-invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink CItem)
+invRootTrees :: IM.IntMap Item -> IM.IntMap (LDTree ItemLink CItem)
 invRootTrees = IM.fromDistinctAscList . reverse . map getid . invLDT
  where
-    getid ::
-        LabelDoubleTree ItemLink CItem ->
-        (Int, LabelDoubleTree ItemLink CItem)
+    getid :: LDTree ItemLink CItem -> (Int, LDTree ItemLink CItem)
    getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)

 -- returns an intmap with indents and locations for all items