Allow for more complex item composition

This commit is contained in:
2024-09-26 00:00:46 +01:00
parent 61f07be08b
commit 772886c8c6
8 changed files with 285 additions and 191 deletions
+63 -8
View File
@@ -1,10 +1,65 @@
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:(26,17)-(29,5): warning: [-Wunused-top-binds]
Defined but not used: data constructor LinkTest
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:39:1-9: warning: [-Wunused-top-binds]
Defined but not used: cisToItem
|
26 | data LinkTest = LinkTest
| ^^^^^^^^^...
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:(32,19)-(37,5): warning: [-Wunused-top-binds]
Defined but not used: data constructor LinkUpdate
39 | cisToItem (x, _, _, _) = x
| ^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:43:10-12: warning: [-Wunused-matches]
Defined but not used: hit
|
32 | data LinkUpdate = LinkUpdate
| ^^^^^^^^^^...
43 | HELD hit -> (itm, WeaponPlatformSF, useBreakListsLinkTest
| ^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:52:1-16: warning: [-Wunused-top-binds]
Defined but not used: baseComposedItem
|
52 | baseComposedItem ibt itm = case ibt of
| ^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:63:1-16: warning: [-Wunused-top-binds]
Defined but not used: heldComposedItem
|
63 | heldComposedItem itm hit = case hit of
| ^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:74:1-16: warning: [-Wunused-top-binds]
Defined but not used: ammoComposedItem
|
74 | ammoComposedItem itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
| ^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:79:1-7: warning: [-Wunused-top-binds]
Defined but not used: baseCIS
|
79 | baseCIS itm =
| ^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:99:1-19: warning: [-Wunused-top-binds]
Defined but not used: leftIsParentCombine
|
99 | leftIsParentCombine (LDT (itm, p, lc, rc) lt rt) t'@(LDT (_, p', _, _) _ _) = do
| ^^^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:106:1-20: warning: [-Wunused-top-binds]
Defined but not used: rightIsParentCombine
|
106 | rightIsParentCombine t'@(LDT (_, p', _, _) _ _) (LDT (itm, p, lc, rc) lt rt) = do
| ^^^^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:138:1-6: warning: [-Wunused-top-binds]
Defined but not used: invLDT
|
138 | invLDT =
| ^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:161:1-10: warning: [-Wunused-top-binds]
Defined but not used: invRootMap
|
161 | invRootMap = foldMap (dtToIntMapWithRoot (^?! _1 . itLocation . ilInvID) . ldtToDT) . invLDT
| ^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:175:1-6: warning: [-Wunused-top-binds]
Defined but not used: invAdj
|
175 | invAdj im = do
| ^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:199:1-11: warning: [-Wunused-top-binds]
Defined but not used: invIndentIM
|
199 | invIndentIM = IM.fromAscList . zip [0 ..] . reverse . map (over _1 cisToItem) . concatMap ldtToIndentList . invLDT
| ^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:206:1-8: warning: [-Wunused-top-binds]
Defined but not used: invTrees
|
206 | invTrees = IM.unions . map (ldtToIM getindex) . map (fmap cisToItem) . invLDT
| ^^^^^^^^
+2 -2
View File
@@ -27,7 +27,7 @@ useRootItem :: Int -> World -> World
useRootItem crid w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix crid
itRef <- cr ^? crManipulation . manObject . imRootItem
it <- invTrees (_crInv cr) ^? ix itRef
it <- invTrees' (_crInv cr) ^? ix itRef
return $
itemEffect cr it w
& worldEventFlags . at InventoryChange ?~ ()
@@ -115,7 +115,7 @@ useItemLeftClick' :: Creature -> World -> World
useItemLeftClick' cr' w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
itRef <- cr ^? crManipulation . manObject . imSelectedItem
it <- invTrees (_crInv cr) ^? ix itRef
it <- invTrees' (_crInv cr) ^? ix itRef
return $
itemEffect cr it w
& worldEventFlags . at InventoryChange ?~ ()
+21 -2
View File
@@ -9,6 +9,8 @@ import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Item.Use.Consumption.Ammo
-- it would be nice not to have to import the following...
import Dodge.Data.Item
data ComposeLinkType
= AmmoInLink Int AmmoType
@@ -21,10 +23,11 @@ data ComposeLinkType
data ItemStructuralFunction
= WeaponPlatformSF
| WeaponScopeSF
| WeaponBarrelAttachmentSF
| AmmoMagazineSF
| WeaponTargetingSF
| AmmoMagSF
| RemoteScreenSF
| UncomposableIsolateSF
| AmmoModifierSF AmmoType
deriving (Eq,Ord,Show,Read)
data ComposedItem = WeaponCI
@@ -36,6 +39,22 @@ data ComposedItem = WeaponCI
| RocketRemoteScreenCI
deriving (Eq,Ord,Show,Read)
type PartiallyComposedItem = (Item, ItemStructuralFunction, LinkTest)
data LinkTest = LinkTest
{ _tryLeftLink :: PartiallyComposedItem -> Maybe LinkUpdate
, _tryRightLink :: PartiallyComposedItem -> Maybe LinkUpdate
}
data LinkUpdate = LinkUpdate
{ _luLinkType :: ComposeLinkType
, _luParentUpdate :: PartiallyComposedItem -> PartiallyComposedItem
, _luChildUpdate :: PartiallyComposedItem -> PartiallyComposedItem
}
makeLenses ''LinkTest
makeLenses ''LinkUpdate
makeLenses ''ComposedItem
deriveJSON defaultOptions ''ComposedItem
deriveJSON defaultOptions ''ComposeLinkType
+1 -1
View File
@@ -116,7 +116,7 @@ updateDisplaySections w cfig sss =
--invitems' = MIM.merge MIM.dropMissing MIM.dropMissing (MIM.zipWithMatched $ const addindent) indents $ IM.mapWithKey (invSelectionItem cr) inv
invitems' = IM.mapWithKey (invSelectionItem cr) inv
cr = you w
inv = invIndentIM $ _crInv (you w)
inv = invIndentIM' $ _crInv (you w)
--indents = indentInv inv
--inv = indentInv $ _crInv (you w)
nfreeslots = crNumFreeSlots cr
+3 -2
View File
@@ -20,10 +20,11 @@ import Control.Applicative
-- assumes all item locations inside the items are correct
tryGetRootAttachedFromInvID :: Int -> IM.IntMap Item -> Maybe (Int, IS.IntSet)
tryGetRootAttachedFromInvID invid im = do
let imroots = invRootMap im
let imroots = invRootMap' im
theroot = fromMaybe invid $ imroots ^? ix invid . _1 . _Just
t <- imroots ^? ix theroot . _2
return (theroot, foldMap (IS.singleton . (^?! _1 . itLocation . ilInvID)) t)
--return (theroot, foldMap (IS.singleton . (^?! _1 . itLocation . ilInvID)) t)
return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID)) t)
-- this assumes the creature inventory is well formed, specifically the
+145 -145
View File
@@ -1,43 +1,52 @@
module Dodge.Item.Grammar
(invTrees
, invIndentIM
, invAdj'
, invRootMap
)
where
module Dodge.Item.Grammar (
invTrees',
invIndentIM',
invAdj',
invRootMap',
) where
import Control.Applicative
import Data.Maybe
import ListHelp
import Dodge.Data.Item
import Dodge.Data.DoubleTree
import Dodge.Data.ComposedItem
--import TreeHelp
import LensHelp
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Data.Maybe
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Dodge.Data.Item
import Dodge.DoubleTree
import ListHelp
type ComposedItemStructure
= (Item,ComposedItem,[(ComposeLinkType,ComposedItem)], [(ComposeLinkType,ComposedItem)])
type ComposedItemStructure =
(Item, ComposedItem, [(ComposeLinkType, ComposedItem)], [(ComposeLinkType, ComposedItem)])
type CIL = (ComposedItem, [(ComposeLinkType, ComposedItem)], [(ComposeLinkType, ComposedItem)])
type PartiallyComposedItem = (Item,ItemStructuralFunction,LinkTest)
type CIL = (ComposedItem,[(ComposeLinkType,ComposedItem)], [(ComposeLinkType,ComposedItem)])
data LinkTest = LinkTest
{ _tryLeftLink :: PartiallyComposedItem -> Maybe LinkUpdate
, _tryRightLink :: PartiallyComposedItem -> Maybe LinkUpdate
}
-- may want to upgrade the children's possible links as well, but this is not obvious
data LinkUpdate = LinkUpdate
{ _luLinkType :: ComposeLinkType
, _luNewLinkTest :: LinkTest
, _luParentUpdate :: (Item,PartiallyComposedItem) -> (Item,PartiallyComposedItem)
, _luChildUpdate :: (Item,PartiallyComposedItem) -> (Item,PartiallyComposedItem)
}
useBreakListsLinkTest :: [(ItemStructuralFunction,ComposeLinkType)]
-> [(ItemStructuralFunction,ComposeLinkType)]
-> LinkTest
useBreakListsLinkTest llist rlist = LinkTest ltest rtest
where
ltest (_,sf,_) = do
let xs = dropWhile ((/= sf) . fst) llist
(_,linktype) <- safeHead xs
return $ LinkUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) id
rtest (_,sf,_) = do
let xs = dropWhile ((/= sf) . fst) rlist
(_,linktype) <- safeHead xs
return $ LinkUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
cisToItem :: ComposedItemStructure -> Item
cisToItem (x,_,_,_) = x
cisToItem (x, _, _, _) = x
basePartiallyComposedItem :: Item -> PartiallyComposedItem
basePartiallyComposedItem itm = case itm ^. itType . iyBase of
HELD hit -> (itm, WeaponPlatformSF, useBreakListsLinkTest
[]
[(WeaponTargetingSF,WeaponTargetingLink), (WeaponScopeSF,WeaponScopeLink)]
)
ATTACH (TARGETATTACH{}) -> (itm,WeaponTargetingSF, LinkTest (const Nothing) (const Nothing))
_ -> (itm,UncomposableIsolateSF, LinkTest (const Nothing) (const Nothing))
--AMMOMAG _ -> ammoComposedItem' itm
baseComposedItem :: ItemBaseType -> Item -> CIL
baseComposedItem ibt itm = case ibt of
@@ -52,168 +61,159 @@ baseComposedItem ibt itm = case ibt of
heldComposedItem :: Item -> HeldItemType -> CIL
heldComposedItem itm hit = case hit of
_ -> (WeaponCI, map f ats,
[(WeaponTargetingLink,WeaponTargetingCI),(WeaponScopeLink,WeaponScopeCI)])
_ ->
( WeaponCI
, map f ats
, [(WeaponTargetingLink, WeaponTargetingCI), (WeaponScopeLink, WeaponScopeCI)]
)
where
ats = maybe [] IM.toList $ itm ^? itUse . heldAmmoTypes
f (i,atype) = (AmmoInLink i atype,AmmoCI atype)
f (i, atype) = (AmmoInLink i atype, AmmoCI atype)
ammoComposedItem :: Item -> CIL
ammoComposedItem itm = fromMaybe (error "in ammoComposedItem, wrong item") $ do
atype <- itm ^? itUse . amagType
return (AmmoCI atype, [(AmmoModLink,AmmoModifierCI atype)], [])
return (AmmoCI atype, [(AmmoModLink, AmmoModifierCI atype)], [])
baseCIS :: Item -> ComposedItemStructure
baseCIS itm = let (a,b,c) = baseComposedItem (itm ^. itType . iyBase) itm
in (itm, a, b, c)
baseCIS itm =
let (a, b, c) = baseComposedItem (itm ^. itType . iyBase) itm
in (itm, a, b, c)
type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
leftIsParentCombine' :: LDTComb PartiallyComposedItem ComposeLinkType
leftIsParentCombine' ltree rtree = do
lu <- (ltree ^. ldtValue . _3 . tryRightLink) (rtree ^. ldtValue)
return $ ltree & ldtValue %~ (lu ^. luParentUpdate)
& ldtRight %~ (++ [(lu ^. luLinkType, rtree & ldtValue %~ (lu ^. luChildUpdate))])
rightIsParentCombine' :: LDTComb PartiallyComposedItem ComposeLinkType
rightIsParentCombine' ltree rtree = do
lu <- (rtree ^. ldtValue . _3 . tryLeftLink) (ltree ^. ldtValue)
return $ rtree & ldtValue %~ (lu ^. luParentUpdate)
& ldtLeft .:~ (lu ^. luLinkType, ltree & ldtValue %~ (lu ^. luChildUpdate))
-- the following imposes a strict ordering on the possible attachments
leftIsParentCombine :: LDTComb ComposedItemStructure ComposeLinkType
leftIsParentCombine (LDT (itm,p,lc,rc) lt rt) t'@(LDT (_,p',_,_) _ _) = do
let f (_,x) = p' == x
(_,ys) = break f rc
(linktype,_) <- safeHead ys
return $ LDT (itm,p,lc,tail ys) lt (rt ++ [(linktype,t')])
leftIsParentCombine (LDT (itm, p, lc, rc) lt rt) t'@(LDT (_, p', _, _) _ _) = do
let f (_, x) = p' == x
(_, ys) = break f rc
(linktype, _) <- safeHead ys
return $ LDT (itm, p, lc, tail ys) lt (rt ++ [(linktype, t')])
rightIsParentCombine :: LDTComb ComposedItemStructure ComposeLinkType
rightIsParentCombine t'@(LDT (_,p',_,_) _ _) (LDT (itm,p,lc,rc) lt rt) = do
let f (_,x) = p' == x
(_,ys) = break f lc
(linktype,_) <- safeHead ys
return $ LDT (itm,p,tail ys,rc) ((linktype,t'):lt) rt
rightIsParentCombine t'@(LDT (_, p', _, _) _ _) (LDT (itm, p, lc, rc) lt rt) = do
let f (_, x) = p' == x
(_, ys) = break f lc
(linktype, _) <- safeHead ys
return $ LDT (itm, p, tail ys, rc) ((linktype, t') : lt) rt
leftRightCombine :: LDTComb a b -> LDTComb a b
-> LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
leftRightCombine f f' t1 t2 = f t1 t2
leftRightCombine ::
LDTComb a b ->
LDTComb a b ->
LabelDoubleTree b a ->
LabelDoubleTree b a ->
Maybe (LabelDoubleTree 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
(lab,t'') <- safeHead ls
(lab, t'') <- safeHead ls
tx <- checkdepth t t''
return $ Just $ LDT x ((lab,tx):tail ls) rs
return $ Just $ LDT x ((lab, tx) : tail ls) rs
checktop t t' = f' t t'
joinItemsInList :: (a -> a -> Maybe a) -> [a] -> [a]
joinItemsInList f xs = snd $ h (xs,[])
joinItemsInList f xs = snd $ h (xs, [])
where
h ([],zs) = ([],zs)
h ((y:ys), []) = h (ys, [y])
h ((y:ys),(z:zs)) = case f y z of
Nothing -> h (ys, (y:z:zs))
Just w -> h ((w:ys),zs)
h ([], zs) = ([], zs)
h ((y : ys), []) = h (ys, [y])
h ((y : ys), (z : zs)) = case f y z of
Nothing -> h (ys, (y : z : zs))
Just w -> h ((w : ys), zs)
invLDT :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType ComposedItemStructure]
invLDT = joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems .
fmap (singleLDT . baseCIS)
invLDT =
joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems
. fmap (singleLDT . baseCIS)
invLDT' :: IM.IntMap Item -> [LabelDoubleTree ComposeLinkType PartiallyComposedItem]
invLDT' =
joinItemsInList (leftRightCombine leftIsParentCombine' rightIsParentCombine') . IM.elems
. fmap (singleLDT . basePartiallyComposedItem)
-- this has provoked an error: hopefully it will crop up at some point and get
-- debugged with suitable info
--invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int,Int),[Int],[Int])
--invAdj = IM.unions . fmap (dtToLRAdj getid . ldtToDT) . invLDT
-- where
-- getid (itm, _,_,_) = fromMaybe
-- getid (itm, _,_,_) = fromMaybe
-- (error ("invAdj item " ++ show (_itID itm) ++ " location:" ++ show (itm ^? itLocation . ilInvID)) )
-- $ itm ^? itLocation . ilInvID
-- this assumes the creature inventory is well formed, specifically the
-- location ids
-- consider explicitly reseting the inventory ids (but this probably really
-- should be done upstream anyway in the actually creature inventory)
-- this assumes the creature inventory is well formed, specifically the
-- location ids
-- consider explicitly reseting the inventory ids (but this probably really
-- should be done upstream anyway in the actually creature inventory)
invRootMap :: IM.IntMap Item -> IM.IntMap (Maybe Int, DoubleTree ComposedItemStructure)
invRootMap = foldMap (dtToIntMapWithRoot (^?! _1 . itLocation . ilInvID) . ldtToDT) . invLDT
invRootMap' :: IM.IntMap Item -> IM.IntMap (Maybe Int, DoubleTree Item)
invRootMap' = foldMap (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) . ldtToDT) . invLDT'
--invRootMap = foldMap (dtToRootIntMap g . ldtToDT) . invLDT
-- where
-- g = _
-- this assumes the creature inventory is well formed, specifically the
-- location ids
-- consider explicitly reseting the inventory ids (but this probably really
-- should be done upstream anyway in the actually creature inventory)
invAdj' :: IM.IntMap Item -> Either String (IM.IntMap (Maybe (Int,Int),[Int],[Int]))
invAdj' im = do
-- this assumes the creature inventory is well formed, specifically the
-- location ids
-- consider explicitly reseting the inventory ids (but this probably really
-- should be done upstream anyway in the actually creature inventory)
invAdj :: IM.IntMap Item -> Either String (IM.IntMap (Maybe (Int, Int), [Int], [Int]))
invAdj im = do
l <- mapM g $ invLDT im
return $ IM.unions l
where
g = dtToLRAdjEither getid . ldtToDT
getid (itm, _,_,_) = maybe
(Left ("invAdj' item " ++ show ( _itID itm) ++ " location: " ++ show (itm ^? itLocation)) )
Right $ itm ^? itLocation . ilInvID
getid (itm, _, _, _) =
maybe
(Left ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))
Right
$ itm ^? itLocation . ilInvID
invIndentIM :: IM.IntMap Item -> IM.IntMap (Item,Int, LabelDoubleTreeNodeType ComposeLinkType )
invIndentIM = IM.fromAscList . zip [0..] . reverse . map (over _1 cisToItem) . concatMap ldtToIndentList . invLDT
invAdj' :: IM.IntMap Item -> Either String (IM.IntMap (Maybe (Int, Int), [Int], [Int]))
invAdj' im = do
l <- mapM g $ invLDT' im
return $ IM.unions l
where
g = dtToLRAdjEither getid . ldtToDT
getid (itm, _, _) =
maybe
(Left ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))
Right
$ itm ^? itLocation . ilInvID
invIndentIM :: IM.IntMap Item -> IM.IntMap (Item, Int, LabelDoubleTreeNodeType ComposeLinkType)
invIndentIM = IM.fromAscList . zip [0 ..] . reverse . map (over _1 cisToItem) . concatMap ldtToIndentList . invLDT
invIndentIM' :: IM.IntMap Item -> IM.IntMap (Item, Int, LabelDoubleTreeNodeType ComposeLinkType)
invIndentIM' = IM.fromAscList . zip [0 ..] . reverse . map (over _1 (^. _1))
. concatMap ldtToIndentList . invLDT'
invTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ComposeLinkType Item)
invTrees = IM.unions . map (ldtToIM getindex) . map (fmap cisToItem) . invLDT
where
getindex :: Item -> Int
getindex i = fromMaybe (error "in invTrees try to get non-inventory item tree") $
i ^? itLocation . ilInvID
--indentInv :: IM.IntMap Item -> [String]
--indentInv = concat . fmap (flattenDT . indentDoubleTreeWith (' ':) ('|':) ('+':) . fmap const "")
-- . joinItemsInList joinItems
-- . IM.toList . fmap (singleDT . baseComposedItem)
--
--type PCI = (ComposedItem, [ComposedItem], [ComposedItem])
--
--type PCI' = (Item,ComposedItem,[ComposedItem], [ComposedItem])
--baseComposedItem :: ItemBaseType -> PCI
--baseComposedItem ibt = case ibt of
-- HELD BURSTRIFLE -> (WeaponCI, [BulletAmmoCI], [])
-- AMMOMAG TINMAG -> (BulletAmmoCI, [AmmoModifierCI], [])
-- AMMOMAG DRUMMAG -> (BulletAmmoCI, [AmmoModifierCI], [])
-- ATTACH BULLETSYNTHESIZER -> (AmmoModifierCI, [], [])
-- _ -> (UncomposableCI, [], [])
--
--baseCI :: Item -> PCI'
--baseCI itm = let (a,b,c) = baseComposedItem (itm ^. itType . iyBase)
-- in (itm, a, b, c)
--
--joinItems :: DoubleTree PCI' -> DoubleTree PCI' -> Maybe (DoubleTree PCI')
--joinItems t@(DT (itm,px,lc',rc') ls' rs') s@(DT (_,py,_,_) _ _)
-- | py `elem` rc' = Just (DT (itm,px,lc', delete py rc') ls' (rs' ++ [s]))
-- | otherwise = checkdepth t s
-- where
-- checkdepth a a'@(DT b ls rs) = fromMaybe (checktop a a') $ do
-- c <- safeHead ls
-- d <- checkdepth a c
-- return $ Just $ DT b (d:tail ls) rs
-- checktop a@(DT (_,pa,_,_) _ _) (DT (itm2,pb,lc,rc) ls rs)
-- | pa `elem` lc = Just (DT (itm2,pb, delete pa lc,rc) (a:ls) rs)
-- | otherwise = Nothing
--
--invTree :: IM.IntMap Item -> [String]
--invTree = concatMap (prettyDT (\(itm,_,_,_) -> show (_itType itm))) .
-- joinItemsInList joinItems . IM.elems . fmap (singleDT . baseCI)
--indentInv :: IM.IntMap Item -> IM.IntMap String
--indentInv = IM.fromList . zip [0..] .
-- reverse . concatMap (flattenDT .indentDoubleTreeWith (' ':) ('|':) ('+':) . fmap (const "")) .
-- joinItemsInList joinItems . IM.elems . fmap (singleDT . baseCI)
--
--indentDoubleTreeWith :: (a -> a) -> (a -> a) -> (a -> a) -> DoubleTree a -> DoubleTree a
--indentDoubleTreeWith f g h (DT x l r) = DT x
-- (headMap (iDTL f g h) (iDTboth f g h) l)
-- (lastMap (iDTR f g h) (iDTboth f g h) r)
--
--iDTL :: (a -> a) -> (a -> a) -> (a -> a) -> DoubleTree a -> DoubleTree a
--iDTL fspace fline flink (DT x l r) = DT (flink x)
-- (map (fmap fspace . indentDoubleTreeWith fspace fline flink) l)
-- (map (fmap fline . indentDoubleTreeWith fspace fline flink) r)
--
--iDTR :: (a -> a) -> (a -> a) -> (a -> a) -> DoubleTree a -> DoubleTree a
--iDTR fspace fline flink (DT x l r) = DT (flink x)
-- (map (fmap fline . indentDoubleTreeWith fspace fline flink) l)
-- (map (fmap fspace . indentDoubleTreeWith fspace fline flink) r)
--
--iDTboth :: (a -> a) -> (a -> a) -> (a -> a) -> DoubleTree a -> DoubleTree a
--iDTboth fspace fline flink (DT x l r) = DT (flink x)
-- (map (fmap fline . indentDoubleTreeWith fspace fline flink) l)
-- (map (fmap fline . indentDoubleTreeWith fspace fline flink) r)
--combineMaybe :: (a -> a -> Maybe b) -> (a -> a -> b -> a) -> a -> a -> Maybe a
--combineMaybe t f x y = fmap (f x y) (t x y)
getindex i =
fromMaybe (error "in invTrees try to get non-inventory item tree") $
i ^? itLocation . ilInvID
invTrees' :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ComposeLinkType Item)
invTrees' = IM.unions . map (ldtToIM getindex) . map (fmap (^. _1)) . invLDT'
where
getindex :: Item -> Int
getindex i =
fromMaybe (error "in invTrees try to get non-inventory item tree") $
i ^? itLocation . ilInvID
+1 -1
View File
@@ -40,7 +40,7 @@ doWdWd we = case we of
cr <- w ^? cWorld . lWorld . creatures . ix crid
--it <- getItem itid w
itRef <- cr ^? crManipulation . manObject . imSelectedItem
it <- invTrees (_crInv cr) ^? ix itRef
it <- invTrees' (_crInv cr) ^? ix itRef
return $ doItCrWdWd f it cr w
WdWdFromItCrixWdWd it crid f -> \w -> fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix crid
+49 -30
View File
@@ -72,12 +72,14 @@ Ambush src/Dodge/Data/ActionPlan.hs 178;" C
Ammo src/Dodge/Data/Ammo.hs 4;" m
Ammo src/Dodge/Data/Item/Use/Consumption/Ammo.hs 6;" m
Ammo src/Dodge/Item/Ammo.hs 1;" m
AmmoCI src/Dodge/Data/ComposedItem.hs 25;" C
AmmoInLink src/Dodge/Data/ComposedItem.hs 14;" C
AmmoCI src/Dodge/Data/ComposedItem.hs 37;" C
AmmoInLink src/Dodge/Data/ComposedItem.hs 16;" C
AmmoMagSF src/Dodge/Data/ComposedItem.hs 27;" C
AmmoMagType src/Dodge/Data/Item/Combine.hs 107;" t
AmmoMagUse src/Dodge/Data/Item/Use.hs 65;" C
AmmoModLink src/Dodge/Data/ComposedItem.hs 15;" C
AmmoModifierCI src/Dodge/Data/ComposedItem.hs 24;" C
AmmoModLink src/Dodge/Data/ComposedItem.hs 17;" C
AmmoModifierCI src/Dodge/Data/ComposedItem.hs 36;" C
AmmoModifierSF src/Dodge/Data/ComposedItem.hs 30;" C
AmmoParams src/Dodge/Data/Item/Use.hs 110;" t
AmmoParams src/Dodge/Item/Weapon/AmmoParams.hs 1;" m
AmmoPosition src/Dodge/Item/AmmoPosition.hs 8;" t
@@ -444,10 +446,10 @@ CombineInventoryChange src/Dodge/Data/World.hs 33;" C
Common src/Dodge/Zoning/Common.hs 1;" m
Compile src/Shader/Compile.hs 1;" m
Compose src/Dodge/Tree/Compose.hs 4;" m
ComposeLinkType src/Dodge/Data/ComposedItem.hs 13;" t
ComposedItem src/Dodge/Data/ComposedItem.hs 21;" t
ComposeLinkType src/Dodge/Data/ComposedItem.hs 15;" t
ComposedItem src/Dodge/Data/ComposedItem.hs 33;" t
ComposedItem src/Dodge/Data/ComposedItem.hs 6;" m
ComposedItemStructure src/Dodge/Item/Grammar.hs 19;" t
ComposedItemStructure src/Dodge/Item/Grammar.hs 20;" t
Composite src/Picture/Composite.hs 1;" m
ComsSS src/Dodge/Data/Scenario.hs 98;" C
ConcBall src/Dodge/Data/Bullet.hs 32;" C
@@ -1301,6 +1303,7 @@ ItemParams src/Dodge/Data/Item/Params.hs 16;" t
ItemParams src/Dodge/Tesla/ItemParams.hs 1;" m
ItemScrollTimeFlow src/Dodge/Data/World.hs 61;" C
ItemSpace src/Dodge/Inventory/ItemSpace.hs 1;" m
ItemStructuralFunction src/Dodge/Data/ComposedItem.hs 23;" t
ItemTweaks src/Dodge/Data/Item/Tweak.hs 13;" t
ItemType src/Dodge/Combine/Data.hs 12;" t
ItemType src/Dodge/Data/Item/Combine.hs 16;" t
@@ -1339,7 +1342,7 @@ LBoost src/Dodge/Data/Item/HeldUse.hs 56;" C
LBranches src/TreeExtra.hs 24;" C
LDT src/Dodge/Data/DoubleTree.hs 39;" C
LDTBottomNode src/Dodge/Data/DoubleTree.hs 27;" C
LDTComb src/Dodge/Item/Grammar.hs 55;" t
LDTComb src/Dodge/Item/Grammar.hs 83;" t
LDTMidAboveNode src/Dodge/Data/DoubleTree.hs 25;" C
LDTMidBelowNode src/Dodge/Data/DoubleTree.hs 26;" C
LDTRootNode src/Dodge/Data/DoubleTree.hs 23;" C
@@ -1439,6 +1442,8 @@ LinearShockwave src/Dodge/Data/LinearShockwave.hs 13;" t
LinearShockwave src/Dodge/Data/LinearShockwave.hs 6;" m
Link src/Dodge/Room/Link.hs 6;" m
LinkDecoration src/Dodge/Debug/LinkDecoration.hs 1;" m
LinkTest src/Dodge/Data/ComposedItem.hs 44;" t
LinkUpdate src/Dodge/Data/ComposedItem.hs 49;" t
List src/Dodge/Combine/List.hs 1;" m
List src/Dodge/Render/List.hs 1;" m
ListDisplayParams src/Dodge/Data/SelectionList.hs 18;" t
@@ -1908,6 +1913,7 @@ ParamMID src/Dodge/Data/Item/Params.hs 54;" C
Parameters src/Shader/Parameters.hs 1;" m
Parameters src/Shape/Parameters.hs 1;" m
Params src/Dodge/Data/Item/Params.hs 6;" m
PartiallyComposedItem src/Dodge/Data/ComposedItem.hs 42;" t
PassKey src/Dodge/Item/PassKey.hs 1;" m
PassthroughLockKeyLists src/Dodge/Annotation/Data.hs 19;" C
Path src/Dodge/Path.hs 2;" m
@@ -2149,6 +2155,8 @@ Remote src/Dodge/Item/Weapon/Remote.hs 1;" m
RemoteScope src/Dodge/Data/Item/Attachment.hs 23;" C
RemoteScope src/Dodge/Data/Item/Scope.hs 23;" C
RemoteScope src/Dodge/Item/Attachment/Data.hs 26;" C
RemoteScreenLink src/Dodge/Data/ComposedItem.hs 20;" C
RemoteScreenSF src/Dodge/Data/ComposedItem.hs 28;" C
RemoveCreatureEndo src/Dodge/RemoveCreatureEndo.hs 3;" m
RemoveEquipment src/Dodge/Data/RightButtonOptions.hs 36;" C
RemoveShieldWall src/Dodge/Data/ItEffect.hs 43;" C
@@ -2185,8 +2193,7 @@ RightButtonOptions src/Dodge/Data/RightButtonOptions.hs 6;" m
RightForward src/Dodge/Creature/Stance/Data.hs 35;" C
RightForward src/Dodge/Data/Creature/Stance.hs 33;" C
RoadBlock src/Dodge/Room/RoadBlock.hs 2;" m
RocketRemoteScreenCI src/Dodge/Data/ComposedItem.hs 27;" C
RocketRemoteScreenLink src/Dodge/Data/ComposedItem.hs 18;" C
RocketRemoteScreenCI src/Dodge/Data/ComposedItem.hs 39;" C
Rod src/Dodge/Item/Held/Rod.hs 1;" m
Rod src/Dodge/Item/Weapon/BulletGun/Rod.hs 1;" m
Room src/Dodge/Data/GenWorld.hs 96;" t
@@ -2717,7 +2724,8 @@ TwoHandUnder src/Dodge/Data/Item/Use.hs 182;" C
Type src/Dodge/Data/Damage/Type.hs 6;" m
Typical src/Shape/Data.hs 36;" C
UPtLayer src/Dodge/Picture/Layer/Data.hs 16;" C
UncomposableCI src/Dodge/Data/ComposedItem.hs 26;" C
UncomposableCI src/Dodge/Data/ComposedItem.hs 38;" C
UncomposableIsolateSF src/Dodge/Data/ComposedItem.hs 29;" C
Uncursed src/Dodge/Data/Item/CurseStatus.hs 12;" C
Uncursed src/Dodge/Item/Data.hs 8;" C
UnderGround src/Dodge/Data/Scenario.hs 78;" C
@@ -2877,11 +2885,14 @@ WdWdNegateTrig src/Dodge/Data/WorldEffect.hs 33;" C
WdYouPos src/Dodge/Data/WorldEffect.hs 41;" C
Weapon src/Dodge/Default/Weapon.hs 1;" m
Weapon src/Dodge/Item/Weapon.hs 2;" m
WeaponCI src/Dodge/Data/ComposedItem.hs 21;" C
WeaponScopeCI src/Dodge/Data/ComposedItem.hs 22;" C
WeaponScopeLink src/Dodge/Data/ComposedItem.hs 16;" C
WeaponTargetingCI src/Dodge/Data/ComposedItem.hs 23;" C
WeaponTargetingLink src/Dodge/Data/ComposedItem.hs 17;" C
WeaponCI src/Dodge/Data/ComposedItem.hs 33;" C
WeaponPlatformSF src/Dodge/Data/ComposedItem.hs 24;" C
WeaponScopeCI src/Dodge/Data/ComposedItem.hs 34;" C
WeaponScopeLink src/Dodge/Data/ComposedItem.hs 18;" C
WeaponScopeSF src/Dodge/Data/ComposedItem.hs 25;" C
WeaponTargetingCI src/Dodge/Data/ComposedItem.hs 35;" C
WeaponTargetingLink src/Dodge/Data/ComposedItem.hs 19;" C
WeaponTargetingSF src/Dodge/Data/ComposedItem.hs 26;" C
Weapons src/Dodge/Item/Held/Weapons.hs 1;" m
West src/Dodge/Data/CardinalPoint.hs 7;" C
WinScale src/Dodge/Base/WinScale.hs 1;" m
@@ -3604,6 +3615,9 @@ _lsParam src/Dodge/Data/LightSource.hs 36;" f
_lsPict src/Dodge/Data/LightSource.hs 38;" f
_lsPos src/Dodge/Data/LightSource.hs 28;" f
_lsRad src/Dodge/Data/LightSource.hs 29;" f
_luChildUpdate src/Dodge/Data/ComposedItem.hs 52;" f
_luLinkType src/Dodge/Data/ComposedItem.hs 50;" f
_luParentUpdate src/Dodge/Data/ComposedItem.hs 51;" f
_lwID src/Dodge/Data/LinearShockwave.hs 15;" f
_lwPoints src/Dodge/Data/LinearShockwave.hs 16;" f
_lwPos src/Dodge/Data/LinearShockwave.hs 14;" f
@@ -4167,6 +4181,8 @@ _tractorBeams src/Dodge/Data/LWorld.hs 122;" f
_trieChildren src/SimpleTrie.hs 7;" f
_trieMVal src/SimpleTrie.hs 6;" f
_triggers src/Dodge/Data/LWorld.hs 131;" f
_tryLeftLink src/Dodge/Data/ComposedItem.hs 45;" f
_tryRightLink src/Dodge/Data/ComposedItem.hs 46;" f
_ttDeathEffect src/Dodge/Data/Terminal.hs 82;" f
_ttTriggerID src/Dodge/Data/Terminal.hs 81;" f
_tuDir src/Dodge/Data/Machine.hs 61;" f
@@ -4402,7 +4418,7 @@ allHotkeys src/Dodge/Creature/YourControl.hs 52;" f
allVisibleWalls src/Dodge/Base/Collide.hs 131;" f
alongSegBy src/Geometry.hs 43;" f
ammoCheckI src/Dodge/Item/Weapon/TriggerType.hs 118;" f
ammoComposedItem src/Dodge/Item/Grammar.hs 46;" f
ammoComposedItem src/Dodge/Item/Grammar.hs 73;" f
ammoTweakStrings src/Dodge/Render/HUD.hs 288;" f
amr src/Dodge/Item/Held/Rod.hs 46;" f
amr src/Dodge/Item/Weapon/BulletGun/Rod.hs 56;" f
@@ -4530,11 +4546,12 @@ baseAMRShape src/Dodge/Item/Draw/SPic.hs 444;" f
baseBlockPane src/Dodge/Placement/Instance/Wall.hs 86;" f
baseBlockPane src/Dodge/Placements/Wall.hs 63;" f
baseBlockPane src/Dodge/Room/Placement.hs 93;" f
baseCIS src/Dodge/Item/Grammar.hs 51;" f
baseCIS src/Dodge/Item/Grammar.hs 78;" f
baseCaneShape src/Dodge/Item/Draw/SPic.hs 250;" f
baseComposedItem src/Dodge/Item/Grammar.hs 27;" f
baseComposedItem src/Dodge/Item/Grammar.hs 51;" f
baseDebris src/Dodge/Block/Debris.hs 122;" f
baseFloorTileSize src/Tile.hs 38;" f
basePartiallyComposedItem src/Dodge/Item/Grammar.hs 41;" f
baseRifleShape src/Dodge/Item/Draw/SPic.hs 253;" f
baseRodShape src/Dodge/Item/Draw/SPic.hs 441;" f
baseSMGShape src/Dodge/Item/Draw/SPic.hs 412;" f
@@ -4717,7 +4734,7 @@ circle src/Picture/Base.hs 180;" f
circleDecoration src/Dodge/Placement/TopDecoration.hs 56;" f
circleSolid src/Picture/Base.hs 164;" f
circleSolidCol src/Picture/Base.hs 168;" f
cisToItem src/Dodge/Item/Grammar.hs 24;" f
cisToItem src/Dodge/Item/Grammar.hs 38;" f
clClSpringVel src/Dodge/Update.hs 630;" f
clZoneSize src/Dodge/Zone/Size.hs 3;" f
clZoneSize src/Dodge/Zoning/Cloud.hs 21;" f
@@ -5709,7 +5726,7 @@ healthTest src/Dodge/Room/LasTurret.hs 93;" f
heavyBulDams src/Dodge/Item/Weapon/Bullet.hs 38;" f
heightWallPS src/Dodge/Placement/Instance/Wall.hs 13;" f
heldBounds src/Dodge/Item/Module.hs 27;" f
heldComposedItem src/Dodge/Item/Grammar.hs 38;" f
heldComposedItem src/Dodge/Item/Grammar.hs 62;" f
heldEffect src/Dodge/HeldUse.hs 44;" f
heldInfo src/Dodge/Item/Info.hs 61;" f
heldItemOffset src/Dodge/Item/HeldOffset.hs 24;" f
@@ -5823,20 +5840,20 @@ intersectSegsSeg src/Geometry/Intersect.hs 232;" f
intervalList src/Geometry.hs 315;" f
interweave src/Justify.hs 17;" f
intsToPos src/Dodge/Room/Modify/Girder.hs 160;" f
invAdj' src/Dodge/Item/Grammar.hs 119;" f
invAdj' src/Dodge/Item/Grammar.hs 160;" f
invDimColor src/Dodge/DisplayInventory.hs 140;" f
invDimColor src/Dodge/Inventory/Color.hs 4;" f
invDisplayParams src/Dodge/ListDisplayParams.hs 29;" f
invHead src/Dodge/Render/HUD.hs 296;" f
invIndentIM src/Dodge/Item/Grammar.hs 129;" f
invLDT src/Dodge/Item/Grammar.hs 92;" f
invRootMap src/Dodge/Item/Grammar.hs 109;" f
invIndentIM src/Dodge/Item/Grammar.hs 172;" f
invLDT src/Dodge/Item/Grammar.hs 131;" f
invRootMap src/Dodge/Item/Grammar.hs 149;" f
invSelectionItem src/Dodge/Inventory/SelectionList.hs 35;" f
invSelectionItem' src/Dodge/Inventory/SelectionList.hs 17;" f
invShiftPointBy src/Dodge/ShiftPoint.hs 8;" f
invSideEff src/Dodge/Creature/State.hs 236;" f
invSize src/Dodge/Inventory/CheckSlots.hs 40;" f
invTrees src/Dodge/Item/Grammar.hs 132;" f
invTrees src/Dodge/Item/Grammar.hs 175;" f
inventoryExtra src/Dodge/Render/HUD.hs 189;" f
inventoryExtraH src/Dodge/Render/HUD.hs 193;" f
inventoryX src/Dodge/Creature.hs 115;" f
@@ -5918,7 +5935,7 @@ jShape src/Dodge/Placement/Instance/LightSource.hs 86;" f
jShape src/Dodge/Placements/LightSource.hs 43;" f
jaggedShape src/Dodge/Block/Debris.hs 191;" f
jetPack src/Dodge/Item/Equipment.hs 92;" f
joinItemsInList src/Dodge/Item/Grammar.hs 83;" f
joinItemsInList src/Dodge/Item/Grammar.hs 122;" f
jps0' src/Dodge/LevelGen/Data.hs 60;" f
jps0' src/Dodge/LevelGen/PlacementHelper.hs 60;" f
jps0PushPS src/Dodge/LevelGen/Data.hs 63;" f
@@ -5983,10 +6000,11 @@ ldtToIM src/Dodge/DoubleTree.hs 90;" f
ldtToIndentList src/Dodge/DoubleTree.hs 93;" f
left src/DoubleStack.hs 16;" f
leftInfo src/Dodge/Item/Info.hs 109;" f
leftIsParentCombine src/Dodge/Item/Grammar.hs 58;" f
leftIsParentCombine src/Dodge/Item/Grammar.hs 92;" f
leftIsParentCombine' src/Dodge/Item/Grammar.hs 85;" f
leftItemSPic src/Dodge/Item/Draw/SPic.hs 72;" f
leftPad src/Padding.hs 14;" f
leftRightCombine src/Dodge/Item/Grammar.hs 72;" f
leftRightCombine src/Dodge/Item/Grammar.hs 106;" f
legsSPic src/Dodge/Item/Draw/SPic.hs 528;" f
liShape src/Dodge/Placement/Instance/LightSource.hs 99;" f
liShape src/Dodge/Placements/LightSource.hs 55;" f
@@ -6879,7 +6897,7 @@ rhombus src/Polyhedra.hs 71;" f
rifle src/Dodge/Item/Held/Cane.hs 51;" f
rifle src/Dodge/Item/Weapon/BulletGun/Cane.hs 77;" f
right src/DoubleStack.hs 16;" f
rightIsParentCombine src/Dodge/Item/Grammar.hs 65;" f
rightIsParentCombine src/Dodge/Item/Grammar.hs 99;" f
rightPad src/Padding.hs 22;" f
rightPadNoSquash src/Padding.hs 26;" f
rlPosDir src/Dodge/RoomLink.hs 94;" f
@@ -7788,6 +7806,7 @@ upperPrismPolyTS src/Shape.hs 118;" f
upperRounded src/Shape.hs 181;" f
upsProjectile src/Dodge/Projectile/Update.hs 51;" f
useAmmoParams src/Dodge/Item/Weapon/AmmoParams.hs 17;" f
useBreakListsLinkTest src/Dodge/Item/Grammar.hs 24;" f
useC src/Dodge/Cuse.hs 8;" f
useC' src/Dodge/Cuse.hs 13;" f
useE src/Dodge/Euse.hs 24;" f