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

Move towards working implementation of attachment tree ammo

Browse Source
This commit is contained in:
justin
2024-09-14 10:44:35 +01:00
parent 51e133ebc1
commit cde7bc9aef
13 changed files with 496 additions and 351 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/HeldUse.hs
+80 -67
View File
@@ -1,5 +1,7 @@
module Dodge.HeldUse where
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Color
import Data.Maybe
import Data.Traversable
@@ -25,7 +27,9 @@ import LensHelp
import RandomHelp
import Sound.Data
useMod :: HeldMod -> [([Item] -> Item -> Creature -> World -> World) -> [Item] -> Item -> Creature -> World -> World]
useMod :: HeldMod ->
[(LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World)
-> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World]
useMod hm = case hm of
HeldModNothing -> []
PoisonSprayerMod ->
@@ -358,71 +362,74 @@ mcUseHeld hit = case hit of
LASGUN -> mcShootLaser
_ -> \_ _ -> id
useHeld :: Huse -> [Item] -> Item -> Creature -> World -> World
useHeld :: Huse -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
useHeld hu = case hu of
HeldDoNothing -> const . const $ const id
HeldDoNothing -> const $ const id
HeldUseAmmoParams -> shootBullet
HeldOverNozzlesUseGasParams -> overNozzles useGasParams
HeldPJCreation -> usePjCreation
HeldPJCreationX _ -> usePjCreationX
HeldFireRemoteShell -> fireRemoteShell
HeldDetectorEffect dt -> const $ detectorEffect dt
HeldTeslaArc -> shootTeslaArc
HeldLaser -> shootLaser
HeldCircleLaser -> const circleLaser
HeldDualLaser -> const shootDualLaser
HeldTractor -> const aTractorBeam
HeldDetectorEffect dt -> detectorEffect dt . _ldtValue
HeldTeslaArc -> shootTeslaArc . _ldtValue
HeldLaser -> shootLaser . _ldtValue
HeldCircleLaser -> circleLaser . _ldtValue
HeldDualLaser -> shootDualLaser . _ldtValue
HeldTractor -> aTractorBeam . _ldtValue
-- HeldSonicWave -> aSonicWave
HeldForceField -> const useForceFieldGun
HeldShatter -> const shootShatter
HeldExplodeRemoteShell itid pjid -> const $ const $ const $ explodeRemoteRocket itid pjid
HeldForceField -> useForceFieldGun . _ldtValue
HeldShatter -> shootShatter . _ldtValue
HeldExplodeRemoteShell itid pjid -> const $ const $ explodeRemoteRocket itid pjid
usePjCreation :: [Item] -> Item -> Creature -> World -> World
usePjCreation ams itm cr = fromMaybe id $ do
apm <- ams ^? ix 0
muz <- itm ^? itUse . heldAim . aimMuzzles . ix 0
return $ createProjectile apm muz itm cr
usePjCreation :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
usePjCreation itm cr = fromMaybe id $ do
atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0
leftitms <- itm ^? ldtLeft
mag <- lookup (AmmoInLink atype) leftitms
apm <- mag ^? ldtValue
muz <- itm ^? ldtValue . itUse . heldAim . aimMuzzles . ix 0
return $ createProjectile apm muz (_ldtValue itm) cr
usePjCreationX :: [Item] -> Item -> Creature -> World -> World
usePjCreationX ams itm cr = fromMaybe id $ do
muzs <- itm ^? itUse . heldAim . aimMuzzles
return $ foldr
f id (zip muzs ams)
where
f (muz,am) = (createProjectile am muz itm cr .)
usePjCreationX :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
usePjCreationX itm cr = undefined
--usePjCreationX ams itm cr = fromMaybe id $ do
-- muzs <- itm ^? itUse . heldAim . aimMuzzles
-- return $ foldr
-- f id (zip muzs ams)
-- where
-- f (muz,am) = (createProjectile am muz itm cr .)
overNozzles ::
(Nozzle -> [Item] -> Item -> Creature -> World -> World) ->
[Item] ->
Item ->
(Nozzle -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) ->
LabelDoubleTree ComposeLinkType Item ->
Creature ->
World ->
World
overNozzles = overNozzles' . overNozzle
overNozzles' ::
([Item] -> Item -> Creature -> World -> Nozzle -> (World, Nozzle)) ->
[Item] ->
Item ->
(LabelDoubleTree ComposeLinkType Item -> Creature -> World -> Nozzle -> (World, Nozzle)) ->
LabelDoubleTree ComposeLinkType Item ->
Creature ->
World ->
World
overNozzles' eff ams it cr w = neww & cWorld . lWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
overNozzles' eff itm cr w = neww
& cWorld . lWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
where
it = itm ^. ldtValue
cid = _crID cr
i = w ^?! cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem
(neww, newNozzles) = mapAccumR (eff ams it cr) w $ _sprayNozzles (_itParams it)
(neww, newNozzles) = mapAccumR (eff itm cr) w $ _sprayNozzles (_itParams it)
overNozzle ::
(Nozzle -> [Item] -> Item -> Creature -> World -> World) ->
[Item] ->
Item ->
(Nozzle -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) ->
LabelDoubleTree ComposeLinkType Item ->
Creature ->
World ->
Nozzle ->
(World, Nozzle)
overNozzle eff ams it cr w nz =
( eff nz ams it (cr & crDir +~ wa + na) w & randGen .~ g
overNozzle eff itm cr w nz =
( eff nz itm (cr & crDir +~ wa + na) w & randGen .~ g
, nz & nzCurrentWalkAngle .~ wa
)
where
@@ -441,8 +448,8 @@ getAmmoMagazine itm cr = do
guard $ amtype == magtype
return mag
useGasParams :: Nozzle -> [Item] -> Item -> Creature -> World -> World
useGasParams nz ams _ cr =
useGasParams :: Nozzle -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
useGasParams nz itm cr =
createGas
gastype
(_nzPressure nz)
@@ -450,35 +457,41 @@ useGasParams nz ams _ cr =
dir
cr
where
gastype = fromMaybe (error "cannot find gas ammo") $ ams ^? ix 0 . itUse . amagParams . ampCreateGas
gastype = fromMaybe (error "cannot find gas ammo") $ do
atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0
leftitms <- itm ^? ldtLeft
mag <- lookup (AmmoInLink atype) leftitms
mag ^? ldtValue . itUse . amagParams . ampCreateGas
dir = _crDir cr
pos = _crPos cr +.+ (_nzLength nz *.* unitVectorAtAngle (_crDir cr))
fireRemoteShell :: [Item] -> Item -> Creature -> World -> World
fireRemoteShell ams it cr w =
set
(cWorld . lWorld . creatures . ix cid . crInv . ix j . itUse . heldUse)
(HeldExplodeRemoteShell itid i)
$ addRemRocket w
where
itid = _itID it
i = IM.newKey $ w ^. cWorld . lWorld . props
cid = _crID cr
apm = fromMaybe (error "cannot find shell ammo projectile") $ do
ams ^? ix 0
addRemRocket =
makeShell apm
-- the following is unsafe!
(it ^?! itUse . heldAim . aimMuzzles . ix 0)
it
cr
[ PJRemoteShellCollisionCheck
, PJSetScope itid
, PJDecTimMvVel
, PJThrust 330 0
, PJRemoteDirection 340 0 cid itid
]
j = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
fireRemoteShell :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
fireRemoteShell it cr w = undefined
--fireRemoteShell :: [Item] -> Item -> Creature -> World -> World
--fireRemoteShell ams it cr w =
-- set
-- (cWorld . lWorld . creatures . ix cid . crInv . ix j . itUse . heldUse)
-- (HeldExplodeRemoteShell itid i)
-- $ addRemRocket w
-- where
-- itid = _itID it
-- i = IM.newKey $ w ^. cWorld . lWorld . props
-- cid = _crID cr
-- apm = fromMaybe (error "cannot find shell ammo projectile") $ do
-- ams ^? ix 0
-- addRemRocket =
-- makeShell apm
-- -- the following is unsafe!
-- (it ^?! itUse . heldAim . aimMuzzles . ix 0)
-- it
-- cr
-- [ PJRemoteShellCollisionCheck
-- , PJSetScope itid
-- , PJDecTimMvVel
-- , PJThrust 330 0
-- , PJRemoteDirection 340 0 cid itid
-- ]
-- j = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
caneStickSoundChoice :: Item -> SoundID
caneStickSoundChoice _ = tap3S
@@ -511,8 +524,8 @@ mcShootLaser it mc = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParam
dam = _lasDamage $ _itParams it
-- | assumes that the item is held
shootTeslaArc :: [Item] -> Item -> Creature -> World -> World
shootTeslaArc _ it cr w =
shootTeslaArc :: Item -> Creature -> World -> World
shootTeslaArc it cr w =
w'
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
where