diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 0482dd30c..b8338d60b 100644 --- a/src/Dodge/Combine.hs +++ b/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 } diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index b7bfe8bfd..3ad2f3138 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/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 - case itmtree ^. ldtValue . cItemFunction of + let itm = itmtree ^. ldtValue . _1 + 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 diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 2c0ff0be6..6b69ffd35 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/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) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 84281e16c..ad5539d67 100644 --- a/src/Dodge/Creature/State.hs +++ b/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 - (HELD TORCH, _) -> shineTorch cr itmtree m - (HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr itmtree m - (TARGETING tt, _) -> updateItemTargeting tt cr itm - (ATTACH AUGMENTEDHUD, _) -> drawAugmentedHUD loc - _ -> id +updateItemWithOrientation cr m loc@(LocLDT _ itmtree) = + case (ci ^. _1 . itType, ci ^. _2) of + (HELD TORCH, _) -> shineTorch cr itmtree m + (HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr itmtree m + (TARGETING tt, _) -> updateItemTargeting tt cr itm + (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) diff --git a/src/Dodge/Data/ComposedItem.hs b/src/Dodge/Data/ComposedItem.hs index 6537cd5d9..d17442118 100644 --- a/src/Dodge/Data/ComposedItem.hs +++ b/src/Dodge/Data/ComposedItem.hs @@ -44,10 +44,10 @@ data ItemStructuralFunction type PartiallyComposedItem = (Item, ItemStructuralFunction, LinkTest) -data ComposedItem = CItem - { _cItem :: Item - , _cItemFunction :: ItemStructuralFunction - } +--data ComposedItem = CItem +-- { _cItem :: Item +-- , _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 diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index bb8979ac1..a7b783316 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/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 diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index 87732ee71..3d10233b3 100644 --- a/src/Dodge/Item/Display.hs +++ b/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 cr ci = case (ci ^. cItemFunction, itm ^?! itUse) of +itemNumberDisplay :: Creature -> PartiallyComposedItem -> [String] +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 diff --git a/src/Dodge/Item/Draw.hs b/src/Dodge/Item/Draw.hs index cc35e1ed5..bbbb00219 100644 --- a/src/Dodge/Item/Draw.hs +++ b/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 diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index b1140adfe..0d639a26e 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/src/Dodge/Item/Draw/SPic.hs @@ -19,16 +19,17 @@ import Picture import Shape import ShapePicture -itemTreeSPic :: LabelDoubleTree ItemLink ComposedItem -> SPic -itemTreeSPic (LDT (CItem itm _) l r) = +itemTreeSPic :: LabelDoubleTree ItemLink PartiallyComposedItem -> SPic +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 diff --git a/src/Dodge/Item/Grammar.hs b/src/Dodge/Item/Grammar.hs index d514022eb..dc560fc43 100644 --- a/src/Dodge/Item/Grammar.hs +++ b/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 - $ CItem itm WeaponTargetingSF + $ itemToBreakLists 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.fromDistinctAscList . reverse . map (getid . fmap (\(x, y, _) -> CItem x y)) . invLDT +invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink PartiallyComposedItem) +invRootTrees = IM.fromDistinctAscList . reverse . map (getid) . invLDT where - getid :: LabelDoubleTree ItemLink ComposedItem -> (Int, LabelDoubleTree ItemLink ComposedItem) - getid t = (t ^?! ldtValue . cItem . itLocation . ilInvID, t) + getid :: LabelDoubleTree ItemLink PartiallyComposedItem + -> (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)) diff --git a/src/Dodge/Item/InventoryColor.hs b/src/Dodge/Item/InventoryColor.hs index 85532c229..2847fc227 100644 --- a/src/Dodge/Item/InventoryColor.hs +++ b/src/Dodge/Item/InventoryColor.hs @@ -8,8 +8,8 @@ import Color import Control.Lens import Dodge.Data.ComposedItem -itemInvColor :: ComposedItem -> Color -itemInvColor ci = case ci ^. cItemFunction of +itemInvColor :: PartiallyComposedItem -> Color +itemInvColor ci = case ci ^. _2 of WeaponPlatformSF -> white EquipmentPlatformSF -> yellow WeaponScopeSF -> chartreuse diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index f81964c59..08a22fb2e 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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 - y <- locLeftmost root ^? locLDT . ldtValue . cItem . itLocation . ilInvID + x <- locRightmost root ^? locLDT . ldtValue . _1 . itLocation . ilInvID + y <- locLeftmost root ^? locLDT . ldtValue . _1 . itLocation . ilInvID return (x, y) drawMouseOver :: Configuration -> World -> Picture