Continue LDT -> DT

This commit is contained in:
2025-07-12 14:08:17 +01:00
parent f47f99eac4
commit 3dc70c483a
+9 -9
View File
@@ -1,7 +1,7 @@
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
module Dodge.Item.Grammar ( module Dodge.Item.Grammar (
invDT, invDT,
invLDT, -- invLDT,
invDT', invDT',
invAdj, invAdj,
invRootMap, invRootMap,
@@ -246,10 +246,10 @@ joinItemsInList f = fst . h . ([],)
Just w -> h ( zs,w : ys) Just w -> h ( zs,w : ys)
-- this puts the first elements in the intmap at the end of the list -- this puts the first elements in the intmap at the end of the list
invLDT :: IM.IntMap Item -> [LDTree ItemLink CItem] --invLDT :: IM.IntMap Item -> [LDTree ItemLink CItem]
invLDT = --invLDT =
joinItemsInList tryAttachItems . IM.elems -- joinItemsInList tryAttachItems . IM.elems
. fmap (singleLDT . baseCI) -- . fmap (singleLDT . baseCI)
invDT :: IM.IntMap Item -> [DTree CItem] invDT :: IM.IntMap Item -> [DTree CItem]
invDT = fmap ldtToDT . invDT = fmap ldtToDT .
@@ -269,8 +269,8 @@ invDT' = fmap propagateOrientation' . invDT
invRootMap :: IM.IntMap Item -> IM.IntMap (Maybe Int, DTree Item) invRootMap :: IM.IntMap Item -> IM.IntMap (Maybe Int, DTree Item)
invRootMap = invRootMap =
foldMap foldMap
(dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) . ldtToDT) (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) )
. invLDT . invDT
-- this assumes the creature inventory is well formed, specifically the -- this assumes the creature inventory is well formed, specifically the
-- location ids -- location ids
@@ -278,9 +278,9 @@ invRootMap =
-- should be done upstream anyway in the actually creature inventory) -- should be done upstream anyway in the actually creature inventory)
-- The first Int in the maybe is the root, the second the parent -- The first Int in the maybe is the root, the second the parent
invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int, Int), [Int], [Int]) invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
invAdj = IM.unions . map g . invLDT invAdj = IM.unions . map g . invDT
where where
g = dtToLRAdj getid . ldtToDT g = dtToLRAdj getid
getid (itm, _) = getid (itm, _) =
fromMaybe fromMaybe
(error ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation))) (error ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))