Continue LDT -> DT
This commit is contained in:
@@ -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)))
|
||||||
|
|||||||
Reference in New Issue
Block a user