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

Move towards using item structural function when using items

Browse Source
This commit is contained in:
justin
2024-10-05 20:53:50 +01:00
parent 7c324a03f6
commit 3b54f00cc7
16 changed files with 142 additions and 111 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/UseItem.hs
+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
src/Dodge/Creature/State.hs
+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
src/Dodge/Data/Item.hs
+11
View File
@@ -13,6 +13,7 @@ module Dodge.Data.Item (
module Dodge.Data.Item.Location,
) where
import Geometry.Data
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Data.Aeson
@@ -35,6 +36,7 @@ data Item = Item
, _itID :: NewInt ItmInt
, _itLocation :: ItemLocation
, _itEffect :: ItEffect
, _itTargeting :: ItemTargeting
, _itAmmoSlots :: IM.IntMap AmmoType
, _itInvSize :: Int
, _itDimension :: ItemDimension
@@ -42,6 +44,15 @@ data Item = Item
, _itParams :: ItemParams
}
data ItemTargeting = NoItTargeting
| ItTargeting
{ _itTgPos :: Maybe Point2
, _itTgID :: Maybe Int
, _itTgActive :: Bool
}
makeLenses ''ItemTargeting
makeLenses ''Item
deriveJSON defaultOptions ''ItemTargeting
deriveJSON defaultOptions ''ItID
deriveJSON defaultOptions ''Item
src/Dodge/Data/Item/Use.hs
+5 -5
View File
@@ -58,11 +58,11 @@ data ItemUse
, _amagType :: AmmoType
}
| UseScope { _uScope :: Scope }
| UseTargeting
{ _tgPos :: Maybe Point2
, _tgID :: Maybe Int
, _tgActive :: Bool
}
-- | UseTargeting
-- { _tgPos :: Maybe Point2
-- , _tgID :: Maybe Int
-- , _tgActive :: Bool
-- }
| UseBulletMod { _ubMod :: BulletMod }
deriving (Eq, Show, Read)
src/Dodge/Default/Item.hs
+1
View File
@@ -27,6 +27,7 @@ defaultHeldItem = Item
, _itType = HELD PISTOL
, _itEffect = defaultItEffect
, _itID = 0 -- should this return an error ? const $ error "itID not correctly initialised" ?
, _itTargeting = NoItTargeting
, _itAmmoSlots = mempty
, _itInvSize = 1
, _itLocation = InVoid
src/Dodge/HeldUse.hs
+1 -1
View File
@@ -330,7 +330,7 @@ getBulletType itmtree magtree mz cr w =
where
btraj = fromMaybe BasicBulletTrajectory $ do
targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these?
tp <- targetingtree ^? ldtValue . itUse . tgPos . _Just
tp <- targetingtree ^? ldtValue . itTargeting . itTgPos . _Just
attree <- lookup AmmoTargetingLink (magtree ^. ldtLeft)
bt <- attree ^? ldtValue . itUse . ubMod . bmTrajectory
return $ getBulletTrajectory mz (itmtree ^. ldtValue) bt tp cr w
src/Dodge/Item/Display.hs
+1 -1
View File
@@ -99,7 +99,7 @@ itemNumberDisplay cr itm = case iu of
UseAttach {} -> []
UseAmmoMag {} -> [maybe "" shortShow $ itm ^? itUse . amagLoadStatus . iaLoaded]
UseScope OpticScope {_opticZoom = x} -> [shortShow x]
UseTargeting {_tgPos = mp} -> [maybe "" shortShow mp]
-- UseTargeting {_tgPos = mp} -> [maybe "" shortShow mp]
-- this could be cleaner here...
UseBulletMod {} -> mempty
where
src/Dodge/Item/Grammar.hs
+6 -2
View File
@@ -1,6 +1,5 @@
module Dodge.Item.Grammar (
invLDT,
invTrees',
invTrees,
invIndentIM,
invAdj,
@@ -81,7 +80,12 @@ itemToFunction itm = case itm ^. itType of
_ -> UncomposableIsolateSF
simplePCI :: Item -> PartiallyComposedItem ItemLink
simplePCI itm = (itm, itemToFunction itm, uncurry useBreakL' $ itemToBreakLists itm)
simplePCI itm = case _itType itm of
HELD LASGUN -> (itm, WeaponScopeSF, uncurry useBreakL' $ itemToBreakLists itm)
_ -> (itm, itemToFunction itm, uncurry useBreakL' $ itemToBreakLists itm)
itemLinkTestLeft :: Item -> PartiallyComposedItem (LinkTest ItemLink) -> Maybe (LinkUpdate ItemLink)
itemLinkTestLeft itm pci = Nothing
basePartiallyComposedItem' :: Item -> PartiallyComposedItem ItemLink
basePartiallyComposedItem' itm = simplePCI itm
src/Dodge/Item/Held/BatteryGuns.hs
+5 -8
View File
@@ -48,14 +48,11 @@ lasGun =
& itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0
& itUse . heldAim . aimMuzzles . ix 0 . mzFlareType .~ LasGunFlare
& itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleLaser
-- & itParams
-- .~ Refracting
-- { _phaseV = 1
-- , _lasColor = yellow
-- , _lasColor2 = yellow
-- , _lasCycle = 0
-- , _lasDamage = 11
-- }
& itTargeting .~ ItTargeting
{ _itTgPos = Nothing
, _itTgID = Nothing
, _itTgActive = False
}
& itDimension . dimRad .~ 10
& itDimension . dimCenter .~ V3 15 0 0
& itUse . heldAim . aimWeight .~ 6
src/Dodge/Item/Scope.hs
+10 -8
View File
@@ -25,17 +25,19 @@ targetingScope tt= case tt of
TARGETLASER -> defaultHeldItem
& itType .~ TARGETING tt
& itAmmoSlots .~ singleAmmo ElectricalAmmo
& itUse .~ UseTargeting
{ _tgPos = Nothing
, _tgID = Nothing
, _tgActive = False
& itUse .~ UseCraft
& itTargeting .~ ItTargeting
{ _itTgPos = Nothing
, _itTgID = Nothing
, _itTgActive = False
}
_ -> defaultHeldItem
& itType .~ TARGETING tt
& itUse .~ UseTargeting
{ _tgPos = Nothing
, _tgID = Nothing
, _tgActive = False
& itUse .~ UseCraft
& itTargeting .~ ItTargeting
{ _itTgPos = Nothing
, _itTgID = Nothing
, _itTgActive = False
}
homingModule :: Item
src/Dodge/Laser/Update.hs
+1 -1
View File
@@ -15,7 +15,7 @@ updateLaser w pt =
( case _lpType pt of
DamageLaser dam -> damThingHitWith
(\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w
TargetingLaser itid -> w & pointerToItemID itid . itUse . tgPos ?~ last ps
TargetingLaser itid -> w & pointerToItemID itid . itTargeting . itTgPos ?~ last ps
, Laser{_lzPoints = sp : ps, _lzColor = _lpColor pt, _lzType = _lpType pt}
)
where
src/Dodge/Projectile/Update.hs
+1 -1
View File
@@ -121,7 +121,7 @@ pjRemoteSetDirection ph pj w = case ph of
in w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc
.~ magV (_prjAcc pj) *.* unitVectorAtAngle newdir
HomeUsingTargeting itid -> fromMaybe w $ do
tp <- w ^? pointerToItemID itid . itUse . tgPos . _Just
tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just
return $ w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc
%~ vecTurnTo 0.2 (_prjPos pj) tp
src/Dodge/Targeting/Draw.hs
+2 -2
View File
@@ -12,8 +12,8 @@ import Picture
-- it would be nice to get rid of some redundant checks here
drawTargeting :: Item -> World -> Picture
drawTargeting itm w = fromMaybe mempty $ do
p <- itm ^? itUse . tgPos . _Just
let thepic = case itm ^? itUse . tgActive of
p <- itm ^? itTargeting . itTgPos . _Just
let thepic = case itm ^? itTargeting . itTgActive of
Just True -> activeTargetCursorPic
_ -> targetCursorPic
return