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

Continue removing LDTs

Browse Source
This commit is contained in:
justin
2025-07-12 14:01:44 +01:00
parent 8ff607675b
commit f47f99eac4
15 changed files with 359 additions and 257 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Grammar.hs
+78 -48
View File
@@ -2,14 +2,14 @@
module Dodge.Item.Grammar (
invDT,
invLDT,
invLDT',
invDT',
invAdj,
invRootMap,
invRootTrees,
invRootTrees',
-- invRootTrees,
invIMDT,
baseCI,
allInvLocs,
allInvLocs',
invIndents,
-- allInvLocs,
) where
import Dodge.Item.Orientation
@@ -256,8 +256,11 @@ invDT = fmap ldtToDT .
joinItemsInList tryAttachItems . IM.elems
. fmap (singleLDT . baseCI)
invLDT' :: IM.IntMap Item -> [LDTree ItemLink OItem]
invLDT' = fmap propagateOrientation . invLDT
--invLDT' :: IM.IntMap Item -> [LDTree ItemLink OItem]
--invLDT' = fmap propagateOrientation . invLDT
invDT' :: IM.IntMap Item -> [DTree OItem]
invDT' = fmap propagateOrientation' . invDT
-- this assumes the creature inventory is well formed, specifically the
-- location ids
@@ -283,57 +286,84 @@ invAdj = IM.unions . map g . invLDT
(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 (LDTree ItemLink OItem)
invRootTrees = fmap propagateOrientation . IM.fromDistinctAscList . reverse . map getid . invLDT
where
getid :: LDTree ItemLink CItem -> (Int, LDTree ItemLink CItem)
getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
---- returns an intmap with trees for (only!) root items, indexed by inventory position
--invRootTrees :: IM.IntMap Item -> IM.IntMap (LDTree ItemLink OItem)
--invRootTrees = fmap propagateOrientation . IM.fromDistinctAscList . reverse . map getid . invLDT
-- where
-- getid :: LDTree ItemLink CItem -> (Int, LDTree ItemLink CItem)
-- getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
invRootTrees' :: IM.IntMap Item -> IM.IntMap (LDTree ItemLink CItem)
invRootTrees' = IM.fromDistinctAscList . reverse . map getid . invLDT
invIMDT :: IM.IntMap Item -> IM.IntMap (DTree OItem)
invIMDT = fmap propagateOrientation' . IM.fromDistinctAscList . reverse . map getid . invDT
where
getid :: LDTree ItemLink CItem -> (Int, LDTree ItemLink CItem)
getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
getid :: DTree CItem -> (Int, DTree CItem)
getid t = (t ^?! dtValue . _1 . itLocation . ilInvID, t)
-- returns an intmap with indents and locations for all items
allInvLocs :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink OItem)
allInvLocs inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees inv)) mempty
--invRootTrees' :: IM.IntMap Item -> IM.IntMap (LDTree ItemLink CItem)
--invRootTrees' = IM.fromDistinctAscList . reverse . map getid . invLDT
-- where
-- getid :: LDTree ItemLink CItem -> (Int, LDTree ItemLink CItem)
-- getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
invIndents :: IM.IntMap Item -> IM.IntMap (Int, LocationDT OItem)
invIndents inv = foldMap (f . LocDT TopDT) (IM.elems (invIMDT inv)) mempty
where
f t = cldtPropagateFold h h g 0 t id
h x _ _ _ = x + 1
f t = cdtPropagateFold h h g 0 t id
h x _ _ = x + 1
g ::
Int ->
LocationLDT ItemLink OItem ->
( IM.IntMap (Int, LocationLDT ItemLink OItem) ->
IM.IntMap (Int, LocationLDT ItemLink OItem)
LocationDT OItem ->
( IM.IntMap (Int, LocationDT OItem) ->
IM.IntMap (Int, LocationDT OItem)
) ->
IM.IntMap (Int, LocationLDT ItemLink OItem) ->
IM.IntMap (Int, LocationLDT ItemLink OItem)
IM.IntMap (Int, LocationDT OItem) ->
IM.IntMap (Int, LocationDT OItem)
g x ldt =
(.)
( IM.insert
(ldt ^?! locLDT . ldtValue . _1 . itLocation . ilInvID)
(ldt ^?! locDT . dtValue . _1 . itLocation . ilInvID)
(x, ldt)
)
-- returns an intmap with indents and locations for all items
allInvLocs' :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink CItem)
allInvLocs' inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees' inv)) mempty
where
f t = cldtPropagateFold h h g 0 t id
h x _ _ _ = x + 1
g ::
Int ->
LocationLDT ItemLink CItem ->
( IM.IntMap (Int, LocationLDT ItemLink CItem) ->
IM.IntMap (Int, LocationLDT ItemLink CItem)
) ->
IM.IntMap (Int, LocationLDT ItemLink CItem) ->
IM.IntMap (Int, LocationLDT ItemLink CItem)
g x ldt =
(.)
( IM.insert
(ldt ^?! locLDT . ldtValue . _1 . itLocation . ilInvID)
(x, ldt)
)
---- returns an intmap with indents and locations for all items
--allInvLocs :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink OItem)
--allInvLocs inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees inv)) mempty
-- where
-- f t = cldtPropagateFold h h g 0 t id
-- h x _ _ _ = x + 1
-- g ::
-- Int ->
-- LocationLDT ItemLink OItem ->
-- ( IM.IntMap (Int, LocationLDT ItemLink OItem) ->
-- IM.IntMap (Int, LocationLDT ItemLink OItem)
-- ) ->
-- IM.IntMap (Int, LocationLDT ItemLink OItem) ->
-- IM.IntMap (Int, LocationLDT ItemLink OItem)
-- g x ldt =
-- (.)
-- ( IM.insert
-- (ldt ^?! locLDT . ldtValue . _1 . itLocation . ilInvID)
-- (x, ldt)
-- )
---- returns an intmap with indents and locations for all items
--allInvLocs' :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink CItem)
--allInvLocs' inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees' inv)) mempty
-- where
-- f t = cldtPropagateFold h h g 0 t id
-- h x _ _ _ = x + 1
-- g ::
-- Int ->
-- LocationLDT ItemLink CItem ->
-- ( IM.IntMap (Int, LocationLDT ItemLink CItem) ->
-- IM.IntMap (Int, LocationLDT ItemLink CItem)
-- ) ->
-- IM.IntMap (Int, LocationLDT ItemLink CItem) ->
-- IM.IntMap (Int, LocationLDT ItemLink CItem)
-- g x ldt =
-- (.)
-- ( IM.insert
-- (ldt ^?! locLDT . ldtValue . _1 . itLocation . ilInvID)
-- (x, ldt)
-- )
src/Dodge/Item/Orientation.hs
+1
View File
@@ -1,6 +1,7 @@
module Dodge.Item.Orientation (
orientAttachment,
propagateOrientation,
propagateOrientation',
) where
import Dodge.Data.ComposedItem