Files
loop/src/Dodge/HeldUse.hs
T

507 lines
15 KiB
Haskell

module Dodge.HeldUse where
import Color
import Data.Maybe
import Data.Traversable
import Dodge.Base.Coordinate
import Dodge.Bullet
import Dodge.Creature.HandPos
import Dodge.Data.World
import Dodge.Gas
import Dodge.Item.Weapon.BatteryGuns
import Dodge.Item.Weapon.Launcher
import Dodge.Item.Weapon.Radar
import Dodge.Item.Weapon.Shatter
import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.Utility
import Dodge.Projectile.Create
import Dodge.SoundLogic
import Dodge.Tesla.Arc
import Dodge.WorldEvent.Flash
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import RandomHelp
import Sound.Data
useMod :: HeldMod -> [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World]
useMod hm = case hm of
HeldModNothing -> []
PoisonSprayerMod ->
[ useAmmoAmount 1
, withSoundForI foamSprayLoopS 5
, ammoCheckI
]
FlameSpitterMod ->
[ withSidePushAfterI 20
, withSidePushI 5
, useAmmoAmount 1
, withRandomItemParams f
, repeatOnFrames [1 .. 9] FlameSpitterRepeatMod
, lockInvFor 10
, useTimeCheck
, ammoCheckI
]
FlameSpitterRepeatMod ->
[ withSidePushAfterI 20
, withSidePushI 5
, useAmmoAmount 1
, withRandomItemParams f
, ammoCheckI
]
FlameThrowerMod ->
[ withSidePushAfterI 20
--, withTempLight 1 100 (V3 1 0 0)
, withSidePushI 5
, useAmmoAmount 1
, ammoCheckI
]
LauncherMod ->
[ useAmmoAmount 1
, withSoundStart tap4S
, useTimeCheck
, ammoCheckI
, hammerCheckI
]
TeslaMod ->
[ useAmmoAmount 1
, withSoundForI elecCrackleS 1
, withTempLight 1 100 (V3 0 0 1)
, ammoCheckI
]
CircleLaserMod ->
[ duplicateItem fLasCircle
, withItemUpdate' increasecycleLasCircle
, useAmmoAmount 1
, withSoundForI tone440sawtoothquietS 2
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
, ammoCheckI
]
LasWideMod n ->
[ withItem $ \it -> duplicateOffsetsV2 (xsLasWide it)
, withItemUpdate' (increasecycleLasWide n)
, crAtMuzPos
, useAmmoAmount 1
, withSoundForI tone440sawtoothquietS 2
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
, ammoCheckI
]
DualBeamMod ->
[ useAmmoAmount 1
, withSoundForI tone440sawtoothquietS 2
, withItem $ \it -> withMuzPosShift (V2 0 (- thegapDualBeam it)) $ flareCircleAt (_lasColor2 $ _itParams it) 0.8
, withItem $ \it -> withMuzPosShift (V2 0 (thegapDualBeam it)) $ flareCircleAt (_lasColor $ _itParams it) 0.8
, ammoCheckI
]
LasMod ->
[ crAtMuzPos
, useAmmoAmount 1
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
, withSoundForI tone440sawtoothquietS 2
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
, ammoCheckI
]
LauncherXMod i ->
[ useAmmoAmount i
, withSoundStart tap4S
, useTimeCheck
, ammoCheckI
, hammerCheckI
]
ShatterMod ->
[ useAmmoAmount 1
-- , withSoundStart tap3S
, useTimeCheck
, ammoHammerCheck
]
AmmoCheckMod -> [ammoCheckI]
AmmoUseCheckMod -> [ammoUseCheck]
AmmoHammerTimeUseOneMod ->
[ useAmmoAmount 1
, useTimeCheck
, ammoHammerCheck
]
BangCaneMod ->
[ withMuzFlareI
, withSmoke 1 black 20 200 5
, withRecoil
, applyInaccuracy
, withTorqueAfter
, useAmmoAmount 1
, withSoundStart tap3S
, useTimeCheck
, ammoHammerCheck
]
VolleyGunMod ->
[ withRecoil
, withMuzFlareI
, applyInaccuracy
, duplicateLoadedBarrels
, withTorqueAfter
, useAllAmmo
, withSoundItemChoiceStart caneStickSoundChoice
, useTimeCheck
, ammoHammerCheck
]
AutoRifleMod ->
-- note this is the same as BangCanemMod with the first changed
[ withMuzFlareI
, withSmoke 1 black 20 200 5
, withRecoil
, applyInaccuracy
, withTorqueAfter
, useAmmoAmount 1
, withSoundStart tap3S
, useTimeCheck
, ammoCheckI
]
BangRodMod ->
[ withRecoil
, withMuzFlareI
, withThickSmokeI
, applyInaccuracy
, withTorqueAfter
, useAmmoAmount 1
, withSoundStart bangEchoS
, useTimeCheck
, ammoHammerCheck
]
ElephantGunMod ->
[ withRecoil
, withMuzFlareI
, withThickSmokeI
, applyInaccuracy
, withTorqueAfter
, useAmmoAmount 1
, withSoundStart bangEchoS
, useTimeCheck
, ammoHammerCheck
]
AutoAmrMod ->
[ withRecoil
, withMuzFlareI
, withThickSmokeI
, applyInaccuracy
, withTorqueAfter
, useAmmoAmount 1
, withSoundStart bangEchoS
, useTimeCheck
, ammoCheckI -- cf ElephantGun
]
MachineGunMod ->
[ withMuzFlareI
, withThinSmokeI
, withSoundStart bangEchoS
, rateIncAB (torqueBeforeAtLeast 0.1 0.1) withTorqueAfter
, ammoCheckI
]
ModWithDirectedTeleport hm' ->
reverse $ withPosDirWallCheck directedTelPos : useMod hm'
BangStickMod ->
[ withRecoil
-- , applyInaccuracy
, spreadLoaded
, withTorqueAfter
, withMuzFlareI
, useAllAmmo
, withSoundItemChoiceStart bangStickSoundChoice
, useTimeCheck
, ammoHammerCheck
]
PistolMod ->
[ withMuzFlareI
, withSidePushI 50
, withRecoil
, withTorqueAfter
, applyInaccuracy
, withSoundStart tap3S
, useAmmoAmount 1
, useTimeCheck
, ammoHammerCheck
]
AutoPistolMod ->
[ withMuzFlareI
, withSidePushI 50
, withRecoil
, withTorqueAfter
, applyInaccuracy
, withSoundStart tap3S
, useAmmoAmount 1
, useTimeCheck
, ammoCheckI
]
MachinePistolMod ->
[ withMuzFlareI
, withRecoil
, withSidePushI 50
, withTorqueAfter
, applyInaccuracy
, withSoundStart tap1S
, useAmmoAmount 1
, useTimeCheck
, ammoCheckI
]
BurstRifleMod ->
[ withRecoil
, withMuzFlareI
, applyInaccuracy
, useAmmoAmount 1
, withSoundStart tap3S
, repeatOnFrames [3, 6] BurstRifleRepeatMod
, lockInvFor 7
, sideEffectOnFrame 7 (\_ cr -> TorqueCr 0.2 (_crID cr)) --(torqueSideEffect 0.2)
, useTimeCheck
, ammoHammerCheck
]
BurstRifleRepeatMod ->
[ withRecoil
, withMuzFlareI
, applyInaccuracy
, useAmmoAmount 1
, withSoundStart tap3S
, sideEffectOnFrame 7 (\_ cr -> TorqueCr 0.2 (_crID cr)) --(torqueSideEffect 0.2)
, ammoCheckI
]
MiniGunMod i ->
reverse [ trigDoAlso' (moddelay x) (modcrpos x) useAmmoParams
| x <- map ((/ fromIntegral i) . fromIntegral) [1 .. i -1]
]
<>
[ afterRecoil (fromIntegral i * 5)
, torqueBefore (fromIntegral i * 0.05)
, withSidePushI (fromIntegral i * 50)
, useAmmoAmount i
, withMuzFlareI
, withSmoke 1 black 20 200 5
--, withThinSmokeI
, withSoundForI mini1S 2
, withWarmUp crankSlowS
, ammoCheckI
]
SmgMod ->
[ withMuzFlareI
, withSidePushI 30
, withRecoil
, withTorqueAfter
, applyInaccuracy
, withSoundStart tap3S
, useAmmoAmount 1
, useTimeCheck
, ammoCheckI
]
RevolverXMod ->
[ withRecoil
, withTorqueAfter
-- , spreadLoaded
, withMuzFlareI
, applyInaccuracy
, useAmmoUpTo 1
, withSoundStart tap3S
, repeatOnFrames [2, 4, 6, 8, 10] RevolverXRepeatMod
, lockInvFor 10
-- rather than locking the inventory, a better solution may be to check
-- that the weapon is still in your hands in the repeated frames
, useTimeCheck
, ammoHammerCheck
]
RevolverXRepeatMod ->
[ withRecoil
, withTorqueAfter
, withMuzFlareI
, applyInaccuracy
, useAmmoUpTo 1
, withSoundStart tap3S
, ammoCheckI
]
BangConeMod ->
[ withRandomItemParams coneRandItemParams
, withRandomItemUpdate coneRandItemUpdate
, withRandomOffset
, applyInaccuracy
, withMuzFlareI
, duplicateLoaded
, withRecoil
, withTorqueAfter
, useAllAmmo
, withSoundStart bangEchoS
, useTimeCheck
, hammerCheckI
, ammoCheckI
]
where
f = do
nzpres <- state $ randomR (3, 4)
return $ sprayNozzles . ix 0 . nzPressure .~ nzpres
increasecycleLasCircle it = it & itParams . lasCycle %~ (flip mod 2000 . (+ 1))
--f it = [it & itParams . lasCycle +~ x | x <- [0,100 .. 1900] ]
fLasCircle it = [it & itParams . lasCycle +~ x | x <- [0, 50 .. 1999]]
increasecycleLasWide n it = case _heldHammer (_itUse it) of
HammerUp -> it & itParams . lasCycle .~ 1
_ -> it & itParams . lasCycle %~ (min (n * 5) . (+ 1))
xsLasWide it = [V2 ((0.2 * yoff x) ^ (2 :: Int)) (yoff x) | x <- [(0 :: Int) .. n' -1]]
where
yoff x = fromIntegral x - fromIntegral (n' -1) / 2
n' = _lasCycle (_itParams it)
thegapDualBeam = _dbGap . _itParams
directedTelPos it cr w = (p, a)
where
p = fromMaybe (_crPos cr) $ it ^? itTargeting . tgPos . _Just
a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- p)
moddelay x = itUse . heldConsumption . laAmmoType . amBullet . buDelayFraction .~ x
modcrpos x cr =
cr & crDir %~ tweenAngles x (_crOldDir cr)
& crPos %~ tweenPoints x (_crOldPos cr)
mcUseHeld :: HeldItemType -> Item -> Machine -> World -> World
mcUseHeld hit = case hit of
LASGUN -> mcShootLaser
_ -> \_ _ -> id
useHeld :: Huse -> 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 (_heldConsumption (_itUse it)))) it
usePjCreationX :: Int -> Item -> Creature -> World -> World
usePjCreationX i it cr =
foldr
f
(createProjectile (_amPjCreation (_laAmmoType (_heldConsumption (_itUse it)))) it cr)
[1 .. i -1]
where
f n = (. createProjectile (_amPjCreation (_laAmmoType (_heldConsumption (_itUse 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 & cWorld . lWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
where
cid = _crID cr
i = crSel $ w ^?! cWorld . lWorld . creatures . ix 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 (_heldConsumption (_itUse 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
(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
addRemRocket =
makeShell
it
cr
[ PJRemoteShellCollisionCheck
, PJSetScope itid
, PJDecTimMvVel
, PJThrust 330 0
, PJRemoteDirection 340 0 cid itid
]
j = crSel cr
caneStickSoundChoice :: Item -> SoundID
caneStickSoundChoice it
| _laLoaded (_heldConsumption (_itUse it)) < 2 = tap3S
| otherwise = shotgunS
bangStickSoundChoice :: Item -> SoundID
bangStickSoundChoice it
| _laLoaded (_heldConsumption (_itUse it)) < 2 = tap3S
| otherwise = shotgunS
coneRandItemUpdate :: State StdGen (Item -> Item)
coneRandItemUpdate = do
wth <- state $ randomR (1, 5)
return (itUse . heldConsumption . laAmmoType . amBullet . buWidth .~ wth)
coneRandItemParams :: State StdGen (ItemParams -> ItemParams)
coneRandItemParams = do
muzv <- state $ randomR (0.5, 1)
rifl <- state $ randomR (0.3, 0.9)
return $ \itparams ->
itparams
{ _muzVel = muzv
, _rifling = rifl
}
mcShootLaser :: Item -> Machine -> World -> World
mcShootLaser it mc = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
where
pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
dir = mc ^?! mcType . _McTurret . tuDir
phasev = _phaseV . _itParams $ it
dam = _lasDamage $ _itParams it
-- | assumes that the item is held
shootTeslaArc :: Item -> Creature -> World -> World
shootTeslaArc it cr w =
w'
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip
where
(w', ip) = shootTeslaArc' (_itParams it) pos dir w
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
dir = _crDir cr