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/Combine.hs
+1 -1
View File
@@ -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
+5 -3
View File
@@ -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
src/Dodge/Creature/Picture.hs
+1 -1
View File
@@ -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
+28 -22
View File
@@ -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)
src/Dodge/Data/ComposedItem.hs
+6 -6
View File
@@ -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
src/Dodge/Inventory/SelectionList.hs
+3 -3
View File
@@ -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
+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
src/Dodge/Render/HUD.hs
+2 -2
View File
@@ -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