Move towards using item structural function when using items

This commit is contained in:
2024-10-05 20:53:50 +01:00
parent 7c324a03f6
commit 3b54f00cc7
16 changed files with 142 additions and 111 deletions
+1 -1
View File
@@ -40,7 +40,7 @@ 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
-- UseTargeting {} -> w
UseAmmoMag{} -> w
UseScope{} -> w
UseBulletMod{} -> w
+35 -34
View File
@@ -166,26 +166,26 @@ invSideEff cr = alaf Endo foldMap f (_crInv cr) . updateHeldRootItem cr
updateHeldRootItem :: Creature -> World -> World
updateHeldRootItem cr = fromMaybe id $ do
invid <- cr ^? crManipulation . manObject . imRootItem
itmtree <- invTrees' (_crInv cr) ^? ix invid
itmtree <- invRootTrees (_crInv cr) ^? ix invid
return $ updateAttachedItems itmtree cr
updateAttachedItems :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
updateAttachedItems :: LabelDoubleTree ItemLink ComposedItem -> Creature -> World -> World
updateAttachedItems itmtree cr =
cldtPropagateFold
chainLinkOrientation
chainLinkOrientation
(updateItemWithOrientation cr)
(heldItemRelativeOrient (_ldtValue itmtree) cr (0, Q.qID))
(heldItemRelativeOrient (fst $ _ldtValue itmtree) cr (0, Q.qID))
(LocLDT TopLDT itmtree)
-- need to check rotation
chainLinkOrientation ::
(Point3, Q.Quaternion Float) ->
Item ->
ComposedItem ->
ItemLink ->
Item ->
ComposedItem ->
(Point3, Q.Quaternion Float)
chainLinkOrientation mo par (ILink lt f) child = (p + Q.rotate q p1, q * q1)
chainLinkOrientation mo (par,_) (ILink lt f) (child,_) = (p + Q.rotate q p1, q * q1)
where
(p, q) = mo
(p1, q1) = f par lt child
@@ -193,7 +193,7 @@ chainLinkOrientation mo par (ILink lt f) child = (p + Q.rotate q p1, q * q1)
updateItemWithOrientation ::
Creature ->
(Point3, Q.Quaternion Float) ->
LocationLDT ItemLink Item ->
LocationLDT ItemLink ComposedItem ->
World ->
World
updateItemWithOrientation cr m loc@(LocLDT _ itmtree) = case _itType itm of
@@ -203,21 +203,21 @@ updateItemWithOrientation cr m loc@(LocLDT _ itmtree) = case _itType itm of
ATTACH AUGMENTEDHUD -> drawAugmentedHUD loc
_ -> id
where
itm = itmtree ^. ldtValue
itm = itmtree ^. ldtValue . _1
drawAugmentedHUD :: LocationLDT ItemLink Item -> World -> World
drawAugmentedHUD :: LocationLDT ItemLink ComposedItem -> World -> World
drawAugmentedHUD (LocLDT con _) w = fromMaybe w $ do
itm <- con ^? cldtParent
itm <- con ^? cldtParent . _1
return $ w & cWorld . lWorld . flares <>~ drawTargeting itm w
shineTargetLaser :: Creature -> LabelDoubleTree ItemLink Item -> (Point3, Q.Quaternion Float)
shineTargetLaser :: Creature -> LabelDoubleTree ItemLink ComposedItem -> (Point3, Q.Quaternion Float)
-> World -> World
shineTargetLaser cr itmtree (p,q) w = fromMaybe (w & pointItUse . tgPos .~ Nothing) $ do
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 . itUse . amagLoadStatus . iaLoaded
i <- mag ^? ldtValue . _1 . itUse . amagLoadStatus . iaLoaded
guard $ i >= x
maginvid <- mag ^? ldtValue . itLocation . ilInvID
maginvid <- mag ^? ldtValue . _1 . itLocation . ilInvID
return $ w
& cWorld . lWorld . creatures . ix (_crID cr)
. crInv . ix maginvid . itUse . amagLoadStatus . iaLoaded -~ x
@@ -234,18 +234,19 @@ shineTargetLaser cr itmtree (p,q) w = fromMaybe (w & pointItUse . tgPos .~ Nothi
isammolink _ = False
pos = _crPos cr + xyV3 (rotate3 cdir (p + V3 5 0 0))
cdir = _crDir cr
itm = itmtree ^. ldtValue
pointItUse = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse
itm = itmtree ^. ldtValue . _1
--pointItUse = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse
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 Item -> (Point3, Q.Quaternion Float) -> World -> World
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 . itUse . amagLoadStatus . iaLoaded
i <- mag ^? ldtValue . _1 . itUse . amagLoadStatus . iaLoaded
guard $ i >= x
invid <- mag ^? ldtValue . itLocation . ilInvID
invid <- mag ^? ldtValue . _1 . 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)
@@ -263,34 +264,34 @@ shineTorch cr itmtree (p, q) = fromMaybe id $ do
updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
updateItemTargeting tt cr itm w = case tt of
_ | not isattached -> w
& pointItUse . tgPos .~ Nothing
& pointItUse . tgActive .~ False
& pointittarg .itTgPos .~ Nothing
& pointittarg .itTgActive .~ False
TARGETLASER -> w
TargetRBPress | rbpressed -> w
& pointItUse . tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
& pointItUse . tgActive .~ True
& pointittarg .itTgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
& pointittarg .itTgActive .~ True
TargetRBPress -> w
& pointItUse . tgPos .~ Nothing
& pointItUse . tgActive .~ False
TargetRBCreature -> w & pointItUse %~ setRBCreatureTargeting cr w
& pointittarg .itTgPos .~ Nothing
& pointittarg .itTgActive .~ False
TargetRBCreature -> w & pointittarg %~ setRBCreatureTargeting cr w
TargetCursor -> w
& pointItUse .~ UseTargeting
& pointittarg .~ ItTargeting
(Just (mouseWorldPos (w ^. input) (w ^. wCam)))
Nothing
True
where
pointItUse = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse
pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
cid = _crID cr
invid = _ilInvID $ _itLocation itm
isattached = itm ^?! itLocation . ilIsAttached
rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
setRBCreatureTargeting :: Creature -> World -> ItemUse -> ItemUse
setRBCreatureTargeting :: Creature -> World -> ItemTargeting -> ItemTargeting
setRBCreatureTargeting cr w ituse
| SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^? tgID . _Just)
| SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (ituse ^?itTgID . _Just)
&& canSeeTarget =
ituse & updatePos & tgActive .~ True
| otherwise = ituse & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False
ituse & updatePos &itTgActive .~ True
| otherwise = ituse &itTgID .~ fmap _crID newtarg & updatePos &itTgActive .~ False
where
newtarg =
safeMinimumOn (dist mwp . _crPos)
@@ -298,11 +299,11 @@ setRBCreatureTargeting cr w ituse
$ crsNearCirc mwp 40 w
canseepos p = hasLOS (_crPos cr) p w
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
updatePos t' = t' & itTgPos .~ posFromMaybeID (_itTgID t')
posFromMaybeID Nothing = Nothing
posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
canSeeTarget = fromMaybe False $ do
cid <- ituse ^? tgID . _Just
cid <- ituse ^?itTgID . _Just
cpos <- w ^? cWorld . lWorld . creatures . ix cid . crPos
Just $ hasLOS cpos (_crPos cr) w