From 772886c8c68d39129f7b889732de044ccc57ca07 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 26 Sep 2024 00:00:46 +0100 Subject: [PATCH] Allow for more complex item composition --- ghcidOutput | 71 ++++++- src/Dodge/Creature/Impulse/UseItem.hs | 4 +- src/Dodge/Data/ComposedItem.hs | 23 +- src/Dodge/DisplayInventory.hs | 2 +- src/Dodge/Inventory/Location.hs | 5 +- src/Dodge/Item/Grammar.hs | 290 +++++++++++++------------- src/Dodge/WorldEffect.hs | 2 +- tags | 79 ++++--- 8 files changed, 285 insertions(+), 191 deletions(-) diff --git a/ghcidOutput b/ghcidOutput index cd5de966b..2a340d88d 100644 --- a/ghcidOutput +++ b/ghcidOutput @@ -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 + | ^^^^^^^^ diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 86ea3d1ba..cb965b591 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -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 ?~ () diff --git a/src/Dodge/Data/ComposedItem.hs b/src/Dodge/Data/ComposedItem.hs index d0f164861..4be287179 100644 --- a/src/Dodge/Data/ComposedItem.hs +++ b/src/Dodge/Data/ComposedItem.hs @@ -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 diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index 2c37f8676..74b532c0e 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -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 diff --git a/src/Dodge/Inventory/Location.hs b/src/Dodge/Inventory/Location.hs index 261a9aaaf..3f29eaab8 100644 --- a/src/Dodge/Inventory/Location.hs +++ b/src/Dodge/Inventory/Location.hs @@ -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 diff --git a/src/Dodge/Item/Grammar.hs b/src/Dodge/Item/Grammar.hs index 81d15b2d5..57f9db3cd 100644 --- a/src/Dodge/Item/Grammar.hs +++ b/src/Dodge/Item/Grammar.hs @@ -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 diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index 9237e847d..036c4ae5e 100644 --- a/src/Dodge/WorldEffect.hs +++ b/src/Dodge/WorldEffect.hs @@ -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 diff --git a/tags b/tags index 0cce088ae..1af6dd79a 100644 --- a/tags +++ b/tags @@ -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