Remove ComposedItem, to be replaced with PartiallyComposedItem

src/Dodge/Combine.hs

@@ -27,7 +27,7 @@ combineList = map f . combineItemListYouX
             , _siHeight = itInvHeight itm
             , _siWidth = 15
             , _siIsSelectable = True
-            , _siColor = itemInvColor . pciToCI $ basePCI itm
+            , _siColor = itemInvColor $ basePCI itm
             , _siOffX = 0
             , _siPayload = CombinableItem is itm
             }

src/Dodge/Creature/Impulse/UseItem.hs

@@ -27,17 +27,19 @@ useRootItem crid w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w
     cr <- w ^? cWorld . lWorld . creatures . ix crid
     itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
     itmtree <- invRootTrees (_crInv cr) ^? ix itRef
-    let itm = itmtree ^. ldtValue . cItem
+    let itm = itmtree ^. ldtValue . _1
-    case itmtree ^. ldtValue . cItemFunction of
+    case itmtree ^. ldtValue . _2 of
         WeaponPlatformSF ->
             return $
-                heldEffect (bimap _iatType _cItem itmtree) cr w
+                heldEffect (bimap _iatType fst3 itmtree) cr w
                     & pointerToItem itm . itUse . heldHammer .~ HammerDown
         EquipmentPlatformSF -> do
             guard (_crHammerPosition cr == HammerUp)
             invid <- itm ^? itLocation . ilInvID
             return $ toggleEquipmentAt invid cr w
         _ -> Nothing
+  where
+    fst3 (x,_,_) = x
 
 --  where
 --    UseHotkey{} -> doequipmentchange

src/Dodge/Creature/Picture.hs

@@ -140,5 +140,5 @@ shoulderSH = translateSHz 20
 drawEquipment :: Creature -> SPic
 {-# INLINE drawEquipment #-}
 drawEquipment cr = foldMap 
-    (itemEquipPict cr . fmap (\(a, b, _) -> CItem a b)) 
+    (itemEquipPict cr) 
     (invLDT $ _crInv cr)

src/Dodge/Creature/State.hs

@@ -237,23 +237,23 @@ updateHeldRootItem cr = fromMaybe id $ do
     itmtree <- invRootTrees (_crInv cr) ^? ix invid
     return $ updateAttachedItems itmtree cr
 
-updateAttachedItems :: LabelDoubleTree ItemLink ComposedItem -> Creature -> World -> World
+updateAttachedItems :: LabelDoubleTree ItemLink PartiallyComposedItem -> Creature -> World -> World
 updateAttachedItems itmtree cr =
     cldtPropagateFold
         chainLinkOrientation
         chainLinkOrientation
         (updateItemWithOrientation cr)
-        (heldItemRelativeOrient (_cItem $ _ldtValue itmtree) cr (0, Q.qID))
+        (heldItemRelativeOrient (itmtree ^. ldtValue . _1) cr (0, Q.qID))
         (LocLDT TopLDT itmtree)
 
 -- need to check rotation
 chainLinkOrientation ::
     (Point3, Q.Quaternion Float) ->
-    ComposedItem ->
+    PartiallyComposedItem ->
     ItemLink ->
-    ComposedItem ->
+    PartiallyComposedItem ->
     (Point3, Q.Quaternion Float)
-chainLinkOrientation mo (CItem par _) (ILink lt f) (CItem child _) =
+chainLinkOrientation mo (par, _, _) (ILink lt f) (child, _, _) =
     (p + Q.rotate q p1, q * q1)
   where
     (p, q) = mo
@@ -262,36 +262,37 @@ chainLinkOrientation mo (CItem par _) (ILink lt f) (CItem child _) =
 updateItemWithOrientation ::
     Creature ->
     (Point3, Q.Quaternion Float) ->
-    LocationLDT ItemLink ComposedItem ->
+    LocationLDT ItemLink PartiallyComposedItem ->
     World ->
     World
-updateItemWithOrientation cr m loc@(LocLDT _ itmtree) = case (ci ^. cItem . itType, ci ^. cItemFunction) of
+updateItemWithOrientation cr m loc@(LocLDT _ itmtree) =
-    (HELD TORCH, _) -> shineTorch cr itmtree m
+    case (ci ^. _1 . itType, ci ^. _2) of
-    (HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr itmtree m
+        (HELD TORCH, _) -> shineTorch cr itmtree m
-    (TARGETING tt, _) -> updateItemTargeting tt cr itm
+        (HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr itmtree m
-    (ATTACH AUGMENTEDHUD, _) -> drawAugmentedHUD loc
+        (TARGETING tt, _) -> updateItemTargeting tt cr itm
-    _ -> id
+        (ATTACH AUGMENTEDHUD, _) -> drawAugmentedHUD loc
+        _ -> id
   where
     ci = itmtree ^. ldtValue
-    itm = ci ^. cItem
+    itm = ci ^. _1
 
-drawAugmentedHUD :: LocationLDT ItemLink ComposedItem -> World -> World
+drawAugmentedHUD :: LocationLDT ItemLink PartiallyComposedItem -> World -> World
 drawAugmentedHUD (LocLDT con _) w = fromMaybe w $ do
-    itm <- con ^? cldtParent . cItem
+    itm <- con ^? cldtParent . _1
     return $ w & cWorld . lWorld . flares <>~ drawTargeting itm w
 
 shineTargetLaser ::
     Creature ->
-    LabelDoubleTree ItemLink ComposedItem ->
+    LabelDoubleTree ItemLink PartiallyComposedItem ->
     (Point3, Q.Quaternion Float) ->
     World ->
     World
 shineTargetLaser cr itmtree (p, q) w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
     guard (crIsAiming cr)
     (_, mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
-    i <- mag ^? ldtValue . cItem . itUse . amagLoadStatus . iaLoaded
+    i <- mag ^? ldtValue . _1 . itUse . amagLoadStatus . iaLoaded
     guard $ i >= x
-    maginvid <- mag ^? ldtValue . cItem . itLocation . ilInvID
+    maginvid <- mag ^? ldtValue . _1 . itLocation . ilInvID
     return $
         w
             & worldEventFlags . at InventoryChange ?~ ()
@@ -316,19 +317,24 @@ shineTargetLaser cr itmtree (p, q) w = fromMaybe (w & pointittarg . itTgPos .~ N
     isammolink _ = False
     pos = _crPos cr + xyV3 (rotate3 cdir (p + V3 5 0 0))
     cdir = _crDir cr
-    itm = itmtree ^. ldtValue . cItem
+    itm = itmtree ^. ldtValue . _1
     pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
     cid = _crID cr
     invid = _ilInvID $ _itLocation itm
     col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
 
-shineTorch :: Creature -> LabelDoubleTree ItemLink ComposedItem -> (Point3, Q.Quaternion Float) -> World -> World
+shineTorch ::
+    Creature ->
+    LabelDoubleTree ItemLink PartiallyComposedItem ->
+    (Point3, Q.Quaternion Float) ->
+    World ->
+    World
 shineTorch cr itmtree (p, q) = fromMaybe id $ do
     (_, mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
-    i <- mag ^? ldtValue . cItem . itUse . amagLoadStatus . iaLoaded
+    i <- mag ^? ldtValue . _1 . itUse . amagLoadStatus . iaLoaded
     guard $ crIsAiming cr
     guard $ i >= x
-    invid <- mag ^? ldtValue . cItem . itLocation . ilInvID
+    invid <- mag ^? ldtValue . _1 . itLocation . ilInvID
     return $
         --(cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 250 0.7 pos'')
         (cWorld . lWorld . lights .:~ LSParam pos'' 250 0.7)

src/Dodge/Data/ComposedItem.hs

@@ -44,10 +44,10 @@ data ItemStructuralFunction
 
 type PartiallyComposedItem = (Item, ItemStructuralFunction, LinkTest)
 
-data ComposedItem = CItem
+--data ComposedItem = CItem
-    { _cItem :: Item
+--    { _cItem :: Item
-    , _cItemFunction :: ItemStructuralFunction
+--    , _cItemFunction :: ItemStructuralFunction
-    }
+--    }
 
 data ItemLink = ILink
     { _iatType :: ComposeLinkType
@@ -65,10 +65,10 @@ data LinkUpdate = LUpdate
     , _luChildUpdate :: PartiallyComposedItem -> PartiallyComposedItem
     }
 
-makeLenses ''ComposedItem
+--makeLenses ''ComposedItem
 makeLenses ''ItemLink
 makeLenses ''LinkTest
 makeLenses ''LinkUpdate
 deriveJSON defaultOptions ''ItemStructuralFunction
-deriveJSON defaultOptions ''ComposedItem
+--deriveJSON defaultOptions ''ComposedItem
 deriveJSON defaultOptions ''ComposeLinkType

src/Dodge/Inventory/SelectionList.hs

@@ -19,11 +19,11 @@ import NewInt
 import Padding
 import Picture.Base
 
-invSelectionItem :: Int -> Creature -> Int -> ComposedItem -> SelectionItem ()
+invSelectionItem :: Int -> Creature -> Int -> PartiallyComposedItem -> SelectionItem ()
 invSelectionItem indent cr i ci =
     SelectionItem
         { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
-        , _siHeight = itInvHeight $ _cItem ci
+        , _siHeight = itInvHeight $ ci ^. _1
         , _siWidth = 15
         , _siIsSelectable = True
         , _siColor = col
@@ -82,6 +82,6 @@ closeButtonToSelectionItem w i = do
 
 closeItemToTextPictures :: FloorItem -> ([String], Color)
 closeItemToTextPictures flit = 
-    (basicItemDisplay it, itemInvColor . pciToCI $ basePCI it)
+    (basicItemDisplay it, itemInvColor $ basePCI it)
   where
     it = _flIt flit

src/Dodge/Item/Display.hs

@@ -13,11 +13,11 @@ import Dodge.Data.Creature
 import LensHelp
 import Padding
 
-itemDisplay :: Creature -> ComposedItem -> [String]
+itemDisplay :: Creature -> PartiallyComposedItem -> [String]
 itemDisplay cr ci =
     zipWithDefaults id (leftPad 15 ' ') itemDisplayPad (basicItemDisplay itm) (itemNumberDisplay cr ci)
   where
-    itm = _cItem ci
+    itm = ci ^. _1
 
 zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
 zipWithDefaults f g h = go
@@ -93,8 +93,8 @@ showAutoRechargeProgress lc = case lc of
 --  where
 --    ic = (itm ^?! itUse . heldConsumption . laSource)
 
-itemNumberDisplay :: Creature -> ComposedItem -> [String]
+itemNumberDisplay :: Creature -> PartiallyComposedItem -> [String]
-itemNumberDisplay cr ci = case (ci ^. cItemFunction, itm ^?! itUse) of
+itemNumberDisplay cr ci = case (ci ^. _2, itm ^?! itUse) of
     (WeaponTargetingSF,_) 
         -> [maybe "" (const "!TARG!") (itm ^? itTargeting . itTgPos . _Just)]
     (_,UseHeld{}) -> []
@@ -108,7 +108,7 @@ itemNumberDisplay cr ci = case (ci ^. cItemFunction, itm ^?! itUse) of
     (_,UseScope OpticScope {_opticZoom = x}) -> [shortShow x]
     (_,UseBulletMod {}) -> mempty
   where
-    itm = ci ^. cItem
+    itm = ci ^. _1
 
 showEquipmentNumber :: Creature -> Item -> [String]
 showEquipmentNumber _ itm = case _eeUse ee of

src/Dodge/Item/Draw.hs

@@ -14,7 +14,7 @@ import Dodge.Item.Draw.SPic
 import Dodge.Item.HeldOffset
 import ShapePicture
 
-itemEquipPict :: Creature -> LabelDoubleTree ItemLink ComposedItem -> SPic
+itemEquipPict :: Creature -> LabelDoubleTree ItemLink PartiallyComposedItem -> SPic
 itemEquipPict cr itmtree = case itm ^. itUse of
     UseHeld{} | itm ^? itLocation . ilIsRoot == Just True 
             && itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem
@@ -25,7 +25,7 @@ itemEquipPict cr itmtree = case itm ^. itUse of
         epos <- cr ^? crInvEquipped . ix i
         return $ equipPosition epos cr attachpos (itemSPic itm)
   where
-    itm = itmtree ^. ldtValue . cItem
+    itm = itmtree ^. ldtValue . _1
 
 equipPosition :: EquipPosition -> Creature -> Point3 -> SPic -> SPic
 equipPosition epos cr p sh = case epos of

src/Dodge/Item/Draw/SPic.hs

@@ -19,16 +19,17 @@ import Picture
 import Shape
 import ShapePicture
 
-itemTreeSPic :: LabelDoubleTree ItemLink ComposedItem -> SPic
+itemTreeSPic :: LabelDoubleTree ItemLink PartiallyComposedItem -> SPic
-itemTreeSPic (LDT (CItem itm _) l r) =
+itemTreeSPic (LDT (itm,_,_) l r) =
     itemSPic itm
         <> foldMap (itemRotTreeSPic itm) (l <> r)
 
-itemRotTreeSPic :: Item -> (ItemLink, LabelDoubleTree ItemLink ComposedItem) -> SPic
+itemRotTreeSPic :: Item -> (ItemLink, LabelDoubleTree ItemLink PartiallyComposedItem) 
+    -> SPic
 itemRotTreeSPic par (il, t) = translateSP p . overPosSP (Q.rotate q) $ itemTreeSPic t
   where
     (p, q) = _iatOrient il par (_iatType il) itm
-    itm = t ^. ldtValue . cItem
+    itm = t ^. ldtValue . _1
 
 itemSPic :: Item -> SPic
 itemSPic it = case it ^. itType of

src/Dodge/Item/Grammar.hs

@@ -4,7 +4,6 @@ module Dodge.Item.Grammar (
     invAdj,
     invRootMap,
     invRootTrees,
-    pciToCI,
     basePCI,
     allInvLocs,
 ) where
@@ -51,9 +50,10 @@ useBreakListsLinkTest llist rlist = LTest ltest rtest
         return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
 
 itemToBreakLists ::
-    ComposedItem ->
+    Item ->
+    ItemStructuralFunction ->
     ([(ItemStructuralFunction, ComposeLinkType)], [(ItemStructuralFunction, ComposeLinkType)])
-itemToBreakLists ci = case (itm ^. itType, ci ^. cItemFunction) of
+itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
     (HELD TORCH, _) -> (getAmmoLinks itm, [])
     (_, WeaponPlatformSF) ->
         ( getAmmoLinks itm
@@ -75,8 +75,6 @@ itemToBreakLists ci = case (itm ^. itType, ci ^. cItemFunction) of
     (ATTACH BULLETSYNTH, _) 
         -> ([(AmmoMagSF ElectricalAmmo, AmmoInLink 0 ElectricalAmmo)],[])
     _ -> ([], [])
-  where
-    itm = ci ^. cItem
 
 getAmmoLinks :: Item -> [(ItemStructuralFunction, ComposeLinkType)]
 getAmmoLinks itm =
@@ -102,9 +100,6 @@ itemToFunction itm = case itm ^. itType of
     EQUIP{} -> EquipmentPlatformSF
     _ -> UncomposableIsolateSF
 
-pciToCI :: PartiallyComposedItem -> ComposedItem
-pciToCI (x, y, _) = CItem x y
-
 basePCI :: Item -> PartiallyComposedItem
 basePCI itm = case _itType itm of
     _ -> (itm, itemToFunction itm, itemBaseConnections itm)
@@ -112,7 +107,7 @@ basePCI itm = case _itType itm of
 itemBaseConnections :: Item -> LinkTest
 itemBaseConnections itm = case _itType itm of
     HELD LASER -> laserLinkTest itm
-    _ -> uncurry useBreakL $ itemToBreakLists (CItem itm (itemToFunction itm))
+    _ -> uncurry useBreakL $ itemToBreakLists itm (itemToFunction itm)
 
 laserLinkTest :: Item -> LinkTest
 laserLinkTest itm = LTest (llleft itm) (llright itm)
@@ -121,19 +116,18 @@ llleft :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
 llleft itm =
     _tryLeftLink
         . uncurry useBreakL
-        . itemToBreakLists
+        $ itemToBreakLists itm WeaponTargetingSF
-        $ CItem itm WeaponTargetingSF
 
 llright :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
 llright itm pci = case pci ^. _1 . itType of
     CRAFT TRANSFORMER -> Just (toLasgunUpdate itm)
-    _ -> _tryRightLink (uncurry useBreakL $ itemToBreakLists (CItem itm WeaponTargetingSF)) pci
+    _ -> _tryRightLink (uncurry useBreakL $ itemToBreakLists itm WeaponTargetingSF) pci
 
 toLasgunUpdate :: Item -> LinkUpdate
 toLasgunUpdate itm =
     LUpdate
         (ILink FunctionChangeLink orientAttachment)
-        (\(par, _, _) -> (par, WeaponPlatformSF, uncurry useBreakL $ itemToBreakLists (CItem itm WeaponPlatformSF)))
+        (\(par, _, _) -> (par, WeaponPlatformSF, uncurry useBreakL $ itemToBreakLists itm WeaponPlatformSF))
         (\(chi, _, up) -> (chi, FunctionChangeSF, up))
 
 --itemLinkTestLeft :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
@@ -221,16 +215,23 @@ invTrees' = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . map (fmap (\(x,
             i ^? itLocation . ilInvID
 
 -- returns an intmap with trees for (only!) root items, indexed by inventory position
-invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink ComposedItem)
+invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink PartiallyComposedItem)
-invRootTrees = IM.fromDistinctAscList . reverse . map (getid . fmap (\(x, y, _) -> CItem x y)) . invLDT
+invRootTrees = IM.fromDistinctAscList . reverse . map (getid) . invLDT
   where
-    getid :: LabelDoubleTree ItemLink ComposedItem -> (Int, LabelDoubleTree ItemLink ComposedItem)
+    getid :: LabelDoubleTree ItemLink PartiallyComposedItem 
-    getid t = (t ^?! ldtValue . cItem . itLocation . ilInvID, t)
+        -> (Int, LabelDoubleTree ItemLink PartiallyComposedItem)
+    getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
 
 -- returns an intmap with indents and locations for all items
-allInvLocs :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink ComposedItem)
+allInvLocs :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink PartiallyComposedItem)
 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 x ldt = (.) (IM.insert (ldt ^?! locLDT . ldtValue . cItem . itLocation . ilInvID) (x, ldt))
+    g :: Int -> LocationLDT ItemLink PartiallyComposedItem 
+        -> (IM.IntMap (Int,  LocationLDT ItemLink PartiallyComposedItem) 
+            -> IM.IntMap (Int,  LocationLDT ItemLink PartiallyComposedItem))
+        -> IM.IntMap (Int,  LocationLDT ItemLink PartiallyComposedItem) 
+        -> IM.IntMap (Int,  LocationLDT ItemLink PartiallyComposedItem) 
+    g x ldt = (.) (IM.insert (ldt ^?! locLDT . ldtValue . _1 . itLocation . ilInvID) 
+        (x, ldt))

src/Dodge/Item/InventoryColor.hs

@@ -8,8 +8,8 @@ import Color
 import Control.Lens
 import Dodge.Data.ComposedItem
 
-itemInvColor :: ComposedItem -> Color
+itemInvColor :: PartiallyComposedItem -> Color
-itemInvColor ci = case ci ^. cItemFunction of
+itemInvColor ci = case ci ^. _2 of
     WeaponPlatformSF -> white
     EquipmentPlatformSF -> yellow
     WeaponScopeSF -> chartreuse

src/Dodge/Render/HUD.hs

@@ -96,8 +96,8 @@ getRootItemBounds i inv = do
     let ia = allInvLocs inv
     itm <- ia ^? ix i . _2
     let root = locToTop itm
-    x <- locRightmost root ^? locLDT . ldtValue . cItem . itLocation . ilInvID
+    x <- locRightmost root ^? locLDT . ldtValue . _1 . itLocation . ilInvID
-    y <- locLeftmost root ^? locLDT . ldtValue . cItem . itLocation . ilInvID
+    y <- locLeftmost root ^? locLDT . ldtValue . _1 . itLocation . ilInvID
     return (x, y)
 
 drawMouseOver :: Configuration -> World -> Picture