justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Remove ComposedItem, to be replaced with PartiallyComposedItem

Browse Source
This commit is contained in:
justin
2024-11-29 10:39:39 +00:00
parent a9edab0e31
commit 7148051b31
12 changed files with 80 additions and 70 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Display.hs
+5 -5
View File
@@ -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
src/Dodge/Item/Draw.hs
+2 -2
View File
@@ -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
+5 -4
View File
@@ -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
src/Dodge/Item/Grammar.hs
+20 -19
View File
@@ -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))
src/Dodge/Item/InventoryColor.hs
+2 -2
View File
@@ -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