Allow for more complex item composition

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 ?~ ()

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

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

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

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

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