Start refactoring held item use

2022-07-20 16:03:35 +01:00
parent 2c6e5e818a
commit eeb98eb151
18 changed files with 164 additions and 109 deletions
@@ -0,0 +1,93 @@
+module Dodge.HeldUse where
+import Dodge.Data
+import Dodge.Bullet
+import Dodge.Item.Location
+import Dodge.Item.Weapon.Radar
+import Dodge.Item.Weapon.BatteryGuns
+import Dodge.Item.Weapon.SonicGuns
+import Dodge.Item.Weapon.Utility
+import Dodge.Item.Weapon.Shatter
+import Dodge.Item.Weapon.Launcher
+import Dodge.Projectile.Create
+import Dodge.Gas
+import Geometry
+import qualified IntMapHelp as IM
+import LensHelp
+import RandomHelp
+
+import Data.Traversable
+
+useHeld :: HeldUse -> Item -> Creature -> World -> World
+useHeld hu = case hu of
+    HeldDoNothing -> const $ const id
+    HeldUseAmmoParams -> useAmmoParams
+    HeldOverNozzlesUseGasParams -> overNozzles useGasParams
+    HeldPJCreation -> usePjCreation
+    HeldPJCreationX i -> usePjCreationX i
+    HeldFireRemoteShell -> fireRemoteShell
+    HeldDetectorEffect dt -> detectorEffect dt
+    HeldTeslaArc -> shootTeslaArc
+    HeldLaser -> shootLaser
+    HeldCircleLaser -> circleLaser
+    HeldDualLaser -> shootDualLaser
+    HeldTractor -> aTractorBeam
+    HeldSonicWave -> aSonicWave
+    HeldForceField -> useForceFieldGun
+    HeldShatter -> shootShatter
+    HeldExplodeRemoteShell itid pjid -> const $ const $ explodeRemoteRocket itid pjid
+
+usePjCreation :: Item -> Creature -> World -> World
+usePjCreation it = createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it
+
+usePjCreationX :: Int -> Item -> Creature -> World -> World
+usePjCreationX i it cr = foldr f 
+    (createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it cr)
+    [1..i-1]
+  where
+    f n = (. createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i)))
+
+overNozzles :: (Nozzle -> Item -> Creature -> World -> World)
+    -> Item -> Creature -> World -> World
+overNozzles = overNozzles' . overNozzle
+
+overNozzles' :: (Item -> Creature -> World -> Nozzle -> (World,Nozzle))
+    -> Item -> Creature -> World -> World
+overNozzles' eff it cr w = neww & creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
+  where
+    cid = _crID cr
+    i = crSel $ _creatures w IM.! cid
+    (neww,newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it)
+
+overNozzle :: (Nozzle -> Item -> Creature -> World -> World)
+    -> Item -> Creature -> World -> Nozzle -> (World, Nozzle)
+overNozzle eff it cr w nz = 
+    ( eff nz it (cr & crDir +~ wa + na) w & randGen .~ g
+    , nz & nzCurrentWalkAngle .~ wa)
+  where
+    na = _nzDir nz
+    (walkamount, g) = randomR (-aspeed,aspeed) (_randGen w)
+    aspeed = _nzWalkSpeed nz
+    maxa = _nzMaxWalkAngle nz
+    wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + walkamount)
+
+useGasParams :: Nozzle -> Item -> Creature -> World -> World
+useGasParams nz it cr = createGas (_amCreateGas (_laAmmoType (_itConsumption it))) 
+    (_nzPressure nz) pos dir cr
+  where 
+    dir = _crDir cr
+    pos = _crPos cr +.+ (_nzLength nz *.* unitVectorAtAngle (_crDir cr))
+
+fireRemoteShell :: Item -> Creature -> World -> World
+fireRemoteShell it cr w = set (creatures . ix cid . crInv . ix j . itUse . rUse)
+        (HeldExplodeRemoteShell itid i)
+    $ addRemRocket w'
+  where
+    (w',itid) = getHeldItemLoc cr w
+    i   = IM.newKey $ _props w
+    cid = _crID cr
+    addRemRocket = makeShell it cr 
+        [ PJSetScope itid
+        , PJThrust 330 0
+        , PJRemoteDirection 340 0 cid itid
+        ]
+    j = crSel cr