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

Make lasGun have multiple functions when attached differently

Browse Source
This commit is contained in:
justin
2024-10-06 11:19:19 +01:00
parent 3b54f00cc7
commit 9860a88c0c
11 changed files with 155 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+3 -2
View File
@@ -282,12 +282,14 @@ testInventory =
stackedInventory :: [Item]
stackedInventory =
[ torch
, torch
, battery
, remoteScreen
, megaShellMag
, targetingScope TARGETLASER
, burstRifle
, megaTinMag 100
, lasGun
, makeTypeCraft TRANSFORMER
, teslaGun
, megaBattery
, flameThrower
@@ -315,7 +317,6 @@ stackedInventory =
, boosterGun
, flatShield
, spawnGun (lamp 5)
, lasGun
-- , lasWide 20
, poisonSprayer
, bulletBeltPack
src/Dodge/Creature/Impulse/UseItem.hs
+24 -3
View File
@@ -26,11 +26,33 @@ 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 <- invRootTrees (_crInv cr) ^? ix itRef
return $
itemUseEffect cr it w
itemUseEffect' cr it w
& worldEventFlags . at InventoryChange ?~ ()
itemUseEffect' :: Creature -> LabelDoubleTree ItemLink ComposedItem -> World -> World
itemUseEffect' cr itmtree w = case itmtree ^. ldtValue . cItemFunction of
WeaponPlatformSF -> heldEffect (bimap _iatType _cItem itmtree) cr w
& pointerToItem itm . itUse . heldHammer .~ HammerDown
_ -> w
-- UseHotkey{} -> doequipmentchange
-- UseEquip{} -> doequipmentchange
-- (UseConsume eff) -> useC eff (_ldtValue itmtree) cr w
-- UseCraft{} -> w
-- UseAttach{} -> selectUse itmtree cr w
-- UseAmmoMag{} -> w
-- UseScope{} -> w
-- UseBulletMod{} -> w
where
itm :: Item
itm = itmtree ^. ldtValue . cItem
-- doequipmentchange = fromMaybe w $ do
-- guard (_crHammerPosition cr == HammerUp)
-- invid <- itm ^? itLocation . ilInvID
-- return $ toggleEquipmentAt invid cr w
itemUseEffect :: Creature -> LabelDoubleTree ComposeLinkType Item -> World -> World
itemUseEffect cr itmtree w = case itmtree ^. ldtValue . itUse of
UseHeld{} -> heldEffect itmtree cr w
@@ -40,7 +62,6 @@ itemUseEffect cr itmtree w = case itmtree ^. ldtValue . itUse of
(UseConsume eff) -> useC eff (_ldtValue itmtree) cr w
UseCraft{} -> w
UseAttach{} -> selectUse itmtree cr w
-- UseTargeting {} -> w
UseAmmoMag{} -> w
UseScope{} -> w
UseBulletMod{} -> w
src/Dodge/Creature/Picture.hs
+2 -1
View File
@@ -9,6 +9,7 @@ module Dodge.Creature.Picture (
deadFeet,
) where
import Dodge.Data.ComposedItem
import Control.Lens
import Dodge.Creature.HandPos (translateToLeftHand, translateToRightHand)
import Dodge.Creature.Test
@@ -138,4 +139,4 @@ shoulderSH = translateSHz 20
drawEquipment :: Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment cr = foldMap (itemEquipPict cr . fmap (\(a, b, _) -> (a, b))) (invLDT $ _crInv cr)
drawEquipment cr = foldMap (itemEquipPict cr . fmap (\(a, b, _) -> CItem a b)) (invLDT $ _crInv cr)
src/Dodge/Creature/State.hs
+9 -9
View File
@@ -175,7 +175,7 @@ updateAttachedItems itmtree cr =
chainLinkOrientation
chainLinkOrientation
(updateItemWithOrientation cr)
(heldItemRelativeOrient (fst $ _ldtValue itmtree) cr (0, Q.qID))
(heldItemRelativeOrient (_cItem $ _ldtValue itmtree) cr (0, Q.qID))
(LocLDT TopLDT itmtree)
-- need to check rotation
@@ -185,7 +185,7 @@ chainLinkOrientation ::
ItemLink ->
ComposedItem ->
(Point3, Q.Quaternion Float)
chainLinkOrientation mo (par,_) (ILink lt f) (child,_) = (p + Q.rotate q p1, q * q1)
chainLinkOrientation mo (CItem par _) (ILink lt f) (CItem child _) = (p + Q.rotate q p1, q * q1)
where
(p, q) = mo
(p1, q1) = f par lt child
@@ -203,11 +203,11 @@ updateItemWithOrientation cr m loc@(LocLDT _ itmtree) = case _itType itm of
ATTACH AUGMENTEDHUD -> drawAugmentedHUD loc
_ -> id
where
itm = itmtree ^. ldtValue . _1
itm = itmtree ^. ldtValue . cItem
drawAugmentedHUD :: LocationLDT ItemLink ComposedItem -> World -> World
drawAugmentedHUD (LocLDT con _) w = fromMaybe w $ do
itm <- con ^? cldtParent . _1
itm <- con ^? cldtParent . cItem
return $ w & cWorld . lWorld . flares <>~ drawTargeting itm w
shineTargetLaser :: Creature -> LabelDoubleTree ItemLink ComposedItem -> (Point3, Q.Quaternion Float)
@@ -215,9 +215,9 @@ shineTargetLaser :: Creature -> LabelDoubleTree ItemLink ComposedItem -> (Point3
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 . _1 . itUse . amagLoadStatus . iaLoaded
i <- mag ^? ldtValue . cItem . itUse . amagLoadStatus . iaLoaded
guard $ i >= x
maginvid <- mag ^? ldtValue . _1 . itLocation . ilInvID
maginvid <- mag ^? ldtValue . cItem . itLocation . ilInvID
return $ w
& cWorld . lWorld . creatures . ix (_crID cr)
. crInv . ix maginvid . itUse . amagLoadStatus . iaLoaded -~ x
@@ -234,7 +234,7 @@ shineTargetLaser cr itmtree (p,q) w = fromMaybe (w & pointittarg . itTgPos .~ No
isammolink _ = False
pos = _crPos cr + xyV3 (rotate3 cdir (p + V3 5 0 0))
cdir = _crDir cr
itm = itmtree ^. ldtValue . _1
itm = itmtree ^. ldtValue . cItem
--pointItUse = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse
pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
cid = _crID cr
@@ -244,9 +244,9 @@ shineTargetLaser cr itmtree (p,q) w = fromMaybe (w & pointittarg . itTgPos .~ No
shineTorch :: Creature -> LabelDoubleTree ItemLink ComposedItem -> (Point3, Q.Quaternion Float) -> World -> World
shineTorch cr itmtree (p, q) = fromMaybe id $ do
(_, mag) <- find (isammolink . _iatType . fst) (itmtree ^. ldtLeft)
i <- mag ^? ldtValue . _1 . itUse . amagLoadStatus . iaLoaded
i <- mag ^? ldtValue . cItem . itUse . amagLoadStatus . iaLoaded
guard $ i >= x
invid <- mag ^? ldtValue . _1 . itLocation . ilInvID
invid <- mag ^? ldtValue . cItem . itLocation . ilInvID
return $
(cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 250 0.7 pos'')
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . amagLoadStatus . iaLoaded -~ x)
src/Dodge/Data/ComposedItem.hs
+18 -9
View File
@@ -23,6 +23,7 @@ data ComposeLinkType
| WeaponTargetingLink
| RemoteScreenLink
| AugmentedHUDLink
| FunctionChangeLink
deriving (Eq, Ord, Show, Read)
data ItemStructuralFunction
@@ -37,28 +38,36 @@ data ItemStructuralFunction
| AmmoTargetingSF AmmoType
| AmmoPayloadSF AmmoType
| AmmoEffectSF AmmoType
| FunctionChangeSF
deriving (Eq, Ord, Show, Read)
type PartiallyComposedItem lt = (Item, ItemStructuralFunction, LinkTest lt)
type ComposedItem = (Item, ItemStructuralFunction)
type PartiallyComposedItem = (Item, ItemStructuralFunction, LinkTest)
data ComposedItem = CItem
{ _cItem :: Item
, _cItemFunction :: ItemStructuralFunction
}
data ItemLink = ILink
{ _iatType :: ComposeLinkType
, _iatOrient :: Item -> ComposeLinkType -> Item -> (Point3, Quaternion Float)
}
data LinkTest lt = LTest
{ _tryLeftLink :: PartiallyComposedItem lt -> Maybe (LinkUpdate lt)
, _tryRightLink :: PartiallyComposedItem lt -> Maybe (LinkUpdate lt)
data LinkTest = LTest
{ _tryLeftLink :: PartiallyComposedItem -> Maybe LinkUpdate
, _tryRightLink :: PartiallyComposedItem -> Maybe LinkUpdate
}
data LinkUpdate lt = LUpdate
{ _luLinkType :: lt
, _luParentUpdate :: PartiallyComposedItem lt -> PartiallyComposedItem lt
, _luChildUpdate :: PartiallyComposedItem lt -> PartiallyComposedItem lt
data LinkUpdate = LUpdate
{ _luLinkType :: ItemLink
, _luParentUpdate :: PartiallyComposedItem -> PartiallyComposedItem
, _luChildUpdate :: PartiallyComposedItem -> PartiallyComposedItem
}
makeLenses ''ComposedItem
makeLenses ''ItemLink
makeLenses ''LinkTest
makeLenses ''LinkUpdate
deriveJSON defaultOptions ''ItemStructuralFunction
deriveJSON defaultOptions ''ComposedItem
deriveJSON defaultOptions ''ComposeLinkType
src/Dodge/Inventory/Location.hs
+1 -1
View File
@@ -2,7 +2,7 @@ module Dodge.Inventory.Location
(updateRootItemID
, crUpdateItemLocations
, setInvPosFromSS
, tryGetRootItemInvID
-- , tryGetRootItemInvID
)
where
src/Dodge/Item/Draw.hs
+1 -1
View File
@@ -24,7 +24,7 @@ itemEquipPict cr itmtree = case itm ^. itUse of
epos <- cr ^? crInvEquipped . ix i
return $ equipPosition epos cr attachpos (itemSPic itm)
where
itm = itmtree ^. ldtValue . _1
itm = itmtree ^. ldtValue . cItem
equipPosition :: EquipPosition -> Creature -> Point3 -> SPic -> SPic
equipPosition epos cr p sh = case epos of
src/Dodge/Item/Draw/SPic.hs
+2 -2
View File
@@ -20,7 +20,7 @@ import Shape
import ShapePicture
itemTreeSPic :: LabelDoubleTree ItemLink ComposedItem -> SPic
itemTreeSPic (LDT (itm, _) l r) =
itemTreeSPic (LDT (CItem itm _) l r) =
itemSPic itm
<> foldMap (itemRotTreeSPic itm) (l <> r)
@@ -28,7 +28,7 @@ itemRotTreeSPic :: Item -> (ItemLink, LabelDoubleTree ItemLink ComposedItem) ->
itemRotTreeSPic par (il, t) = translateSP p . overPosSP (Q.rotate q) $ itemTreeSPic t
where
(p, q) = _iatOrient il par (_iatType il) itm
itm = t ^. ldtValue . _1
itm = t ^. ldtValue . cItem
itemSPic :: Item -> SPic
itemSPic it = case it ^. itType of
src/Dodge/Item/Grammar.hs
+32 -17
View File
@@ -19,13 +19,14 @@ import Dodge.Item.Orientation
import LensHelp
import ListHelp
useBreakL' :: [(ItemStructuralFunction, ComposeLinkType)] -> [(ItemStructuralFunction, ComposeLinkType)]
-> LinkTest ItemLink
useBreakL' x y = useBreakListsLinkTest (map (uncurry noa) x) (map (uncurry noa) y)
useBreakL :: [(ItemStructuralFunction, ComposeLinkType)] -> [(ItemStructuralFunction, ComposeLinkType)]
-> LinkTest
useBreakL x y = useBreakListsLinkTest (map (uncurry noa) x) (map (uncurry noa) y)
where
noa a b = (a, ILink b orientAttachment)
useBreakListsLinkTest :: [(ItemStructuralFunction, a)] -> [(ItemStructuralFunction, a)] -> LinkTest a
useBreakListsLinkTest :: [(ItemStructuralFunction, ItemLink)]
-> [(ItemStructuralFunction, ItemLink)] -> LinkTest
useBreakListsLinkTest llist rlist = LTest ltest rtest
where
ltest (_, sf, _) = do
@@ -79,27 +80,41 @@ itemToFunction itm = case itm ^. itType of
TARGETING{} -> WeaponTargetingSF
_ -> UncomposableIsolateSF
simplePCI :: Item -> PartiallyComposedItem ItemLink
simplePCI :: Item -> PartiallyComposedItem
simplePCI itm = case _itType itm of
HELD LASGUN -> (itm, WeaponScopeSF, uncurry useBreakL' $ itemToBreakLists itm)
_ -> (itm, itemToFunction itm, uncurry useBreakL' $ itemToBreakLists itm)
HELD LASGUN -> (itm, WeaponScopeSF, laserLinkTest itm)
_ -> (itm, itemToFunction itm, uncurry useBreakL $ itemToBreakLists itm)
itemLinkTestLeft :: Item -> PartiallyComposedItem (LinkTest ItemLink) -> Maybe (LinkUpdate ItemLink)
itemLinkTestLeft itm pci = Nothing
laserLinkTest :: Item -> LinkTest
laserLinkTest itm = LTest (llleft itm) (llright itm)
basePartiallyComposedItem' :: Item -> PartiallyComposedItem ItemLink
basePartiallyComposedItem' itm = simplePCI itm
llleft :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
llleft itm pci = _tryLeftLink (uncurry useBreakL $ itemToBreakLists itm) pci
llright :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
llright itm pci = case pci ^. _1 . itType of
CRAFT TRANSFORMER -> Just (toLasgunUpdate itm)
_ -> _tryRightLink (uncurry useBreakL $ itemToBreakLists itm) pci
toLasgunUpdate :: Item -> LinkUpdate
toLasgunUpdate itm = LUpdate (ILink FunctionChangeLink orientAttachment)
(\(par,_,_) -> (par,WeaponPlatformSF,uncurry useBreakL $ itemToBreakLists itm))
(\(chi,_,up) -> (chi,FunctionChangeSF,up))
--itemLinkTestLeft :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
--itemLinkTestLeft itm = _tryLeftLink $
-- uncurry useBreakL $ itemToBreakLists itm
type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)
leftIsParentCombine :: LDTComb (PartiallyComposedItem a) a
leftIsParentCombine :: LDTComb PartiallyComposedItem ItemLink
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 a) a
rightIsParentCombine :: LDTComb PartiallyComposedItem ItemLink
rightIsParentCombine ltree rtree = do
lu <- (rtree ^. ldtValue . _3 . tryLeftLink) (ltree ^. ldtValue)
return $
@@ -131,10 +146,10 @@ joinItemsInList f xs = snd $ h (xs, [])
Nothing -> h (ys, y : z : zs)
Just w -> h (w : ys, zs)
invLDT :: IM.IntMap Item -> [LabelDoubleTree ItemLink (PartiallyComposedItem ItemLink)]
invLDT :: IM.IntMap Item -> [LabelDoubleTree ItemLink PartiallyComposedItem]
invLDT =
joinItemsInList (leftRightCombine leftIsParentCombine rightIsParentCombine) . IM.elems
. fmap (singleLDT . basePartiallyComposedItem')
. fmap (singleLDT . simplePCI)
-- this assumes the creature inventory is well formed, specifically the
-- location ids
@@ -180,7 +195,7 @@ invTrees' = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . map (fmap (\(x,
-- returns an intmap with trees for root items, indexed by inventory position
invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink ComposedItem)
invRootTrees = IM.fromAscList . reverse . map (getid . fmap (\(x, y, _) -> (x, y))) . invLDT
invRootTrees = IM.fromAscList . reverse . map (getid . fmap (\(x, y, _) -> CItem x y)) . invLDT
where
getid :: LabelDoubleTree ItemLink ComposedItem -> (Int,LabelDoubleTree ItemLink ComposedItem)
getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
getid t = (t ^?! ldtValue . cItem . itLocation . ilInvID, t)