540 lines
17 KiB
Haskell
540 lines
17 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.Projectile.Create
|
|
import Dodge.SoundLogic
|
|
import Dodge.Tesla.Arc
|
|
import Dodge.Wall.ForceField
|
|
import Dodge.Wall.Move
|
|
import Dodge.WorldEvent.Flash
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
import RandomHelp
|
|
import Sound.Data
|
|
|
|
useMod :: HeldMod -> [([Item] -> Item -> Creature -> World -> World) -> [Item] -> 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
|
|
, blCheck
|
|
]
|
|
TeslaMod ->
|
|
[ useAmmoAmount 1
|
|
, withSoundForI elecCrackleS 1
|
|
, withTempLight 1 100 (V3 0 0 1)
|
|
, ammoCheckI
|
|
]
|
|
CircleLaserMod ->
|
|
[ duplicateItem fLasCircle
|
|
, useAmmoAmount 1
|
|
, withSoundForI tone440sawtoothquietS 2
|
|
, withItem $ \it -> withCrPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
|
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
|
, withItemUpdateFirst increasecycleLasCircle
|
|
, ammoCheckI
|
|
]
|
|
LasWideMod n ->
|
|
[ useAmmoAmount 1
|
|
, withItem $ \it ->
|
|
duplicateNumBarrels
|
|
-- ( min
|
|
-- (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded)
|
|
(it ^?! itParams . lasCycle `div` lasWideRate)
|
|
-- )
|
|
, withItem $ \it -> withCrPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
|
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
|
, withSoundForI tone440sawtoothquietS 2
|
|
, withItemUpdateFirst (increasecycleLasWide n)
|
|
, ammoCheckI
|
|
]
|
|
DualBeamMod ->
|
|
[ useAmmoAmount 1
|
|
, withSoundForI tone440sawtoothquietS 2
|
|
, withItem $ \it -> withCrPosShift (V2 0 (- thegapDualBeam it)) $ flareCircleAt (_lasColor2 $ _itParams it) 0.8
|
|
, withItem $ \it -> withCrPosShift (V2 0 (thegapDualBeam it)) $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
|
, ammoCheckI
|
|
]
|
|
LasMod ->
|
|
[ useAmmoAmount 1
|
|
, withItem $ \it -> withCrPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
|
, withSoundForI tone440sawtoothquietS 2
|
|
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
|
, duplicateLoadedBarrels
|
|
, ammoCheckI
|
|
]
|
|
LauncherXMod _ ->
|
|
--[ useAmmoAmount i
|
|
--, withSoundStart tap4S
|
|
[ useTimeCheck
|
|
--, ammoCheckI
|
|
, blCheck
|
|
]
|
|
ShatterMod ->
|
|
[ useAmmoAmount 1
|
|
, -- , withSoundStart tap3S
|
|
useTimeCheck
|
|
, ammoCheckI
|
|
, blCheck
|
|
]
|
|
AmmoCheckMod -> [ammoCheckI]
|
|
AmmoUseCheckMod -> [useAmmoAmount 1, useTimeCheck, ammoCheckI]
|
|
AmmoHammerTimeUseOneMod ->
|
|
[ useAmmoAmount 1
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
, blCheck
|
|
]
|
|
BangCaneMod ->
|
|
[ withFlare
|
|
, withSmoke 1 black 20 200 5
|
|
, withRecoil
|
|
, duplicateLoadedBarrels
|
|
, withTorqueAfter
|
|
, useAmmoAmount 1
|
|
, withSoundStart tap3S
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
, blCheck
|
|
]
|
|
VolleyGunMod ->
|
|
[ withRecoil
|
|
, withFlare
|
|
, duplicateLoadedBarrels
|
|
, withTorqueAfter
|
|
, useAllAmmo
|
|
, withSoundItemChoiceStart caneStickSoundChoice
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
, blCheck
|
|
]
|
|
MultiGunMod ->
|
|
[ withRecoil
|
|
, withFlare
|
|
, duplicateLoadedBarrels
|
|
, withTorqueAfter
|
|
, useAllAmmo
|
|
, withSoundItemChoiceStart caneStickSoundChoice
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
, blCheck
|
|
]
|
|
AutoRifleMod ->
|
|
-- note this is the same as BangCanemMod with the first changed
|
|
[ withFlare
|
|
, withSmoke 1 black 20 200 5
|
|
, withRecoil
|
|
, duplicateLoadedBarrels
|
|
, withTorqueAfter
|
|
, useAmmoAmount 1
|
|
, withSoundStart tap3S
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
]
|
|
BangRodMod ->
|
|
[ withRecoil
|
|
, withFlare
|
|
, withThickSmokeI
|
|
, duplicateLoadedBarrels
|
|
, withTorqueAfter
|
|
, useAmmoAmount 1
|
|
, withSoundStart bangEchoS
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
, blCheck
|
|
]
|
|
ElephantGunMod ->
|
|
[ withRecoil
|
|
, withFlare
|
|
, withThickSmokeI
|
|
, duplicateLoadedBarrels
|
|
, withTorqueAfter
|
|
, useAmmoAmount 1
|
|
, withSoundStart bangEchoS
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
, blCheck
|
|
]
|
|
AutoAmrMod ->
|
|
[ withRecoil
|
|
, withFlare
|
|
, withThickSmokeI
|
|
, duplicateLoadedBarrels
|
|
, withTorqueAfter
|
|
, useAmmoAmount 1
|
|
, withSoundStart bangEchoS
|
|
, useTimeCheck
|
|
, ammoCheckI -- cf ElephantGun
|
|
]
|
|
MachineGunMod ->
|
|
[ withFlare
|
|
, withThinSmokeI
|
|
, withSoundStart bangEchoS
|
|
, rateIncAB (torqueBeforeAtLeast 0.1 0.1) withTorqueAfter
|
|
, ammoCheckI
|
|
]
|
|
ModWithDirectedTeleport hm' ->
|
|
reverse $ withPosDirWallCheck directedTelPos : useMod hm'
|
|
BangStickMod ->
|
|
[ withRecoil
|
|
, useAllAmmo
|
|
, withSoundItemChoiceStart bangStickSoundChoice
|
|
, duplicateLoadedBarrels
|
|
, withTorqueAfter
|
|
, withFlare
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
, blCheck
|
|
]
|
|
PistolMod ->
|
|
[ withSidePushI 50
|
|
, withRecoil
|
|
, withFlare
|
|
, withTorqueAfter
|
|
, duplicateLoadedBarrels
|
|
, withSoundStart tap3S
|
|
, useAmmoAmount 1
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
, blCheck
|
|
]
|
|
AutoPistolMod ->
|
|
[ withFlare
|
|
, withSidePushI 50
|
|
, withRecoil
|
|
, withTorqueAfter
|
|
, duplicateLoadedBarrels
|
|
, withSoundStart tap3S
|
|
, useAmmoAmount 1
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
]
|
|
MachinePistolMod ->
|
|
[ withFlare
|
|
, withRecoil
|
|
, withSidePushI 50
|
|
, withTorqueAfter
|
|
, duplicateLoadedBarrels
|
|
, withSoundStart tap1S
|
|
, useAmmoAmount 1
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
]
|
|
BurstRifleMod ->
|
|
[ withRecoil
|
|
, withFlare
|
|
, duplicateLoadedBarrels
|
|
, useAmmoAmount 1
|
|
, withSoundStart tap3S
|
|
, repeatOnFrames [3, 6] BurstRifleRepeatMod
|
|
, lockInvFor 7
|
|
, sideEffectOnFrame 7 (\_ cr -> TorqueCr 0.2 (_crID cr)) --(torqueSideEffect 0.2)
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
, blCheck
|
|
]
|
|
BurstRifleRepeatMod ->
|
|
[ withRecoil
|
|
, withFlare
|
|
, duplicateLoadedBarrels
|
|
, useAmmoAmount 1
|
|
, withSoundStart tap3S
|
|
, sideEffectOnFrame 7 (\_ cr -> TorqueCr 0.2 (_crID cr)) --(torqueSideEffect 0.2)
|
|
, ammoCheckI
|
|
]
|
|
MiniGunMod i ->
|
|
[ duplicateNumBarrels 1
|
|
, repeatTransformed
|
|
[ (id, modcrpos x)
|
|
| x <- map ((/ (fromIntegral i - 1)) . fromIntegral) [0 .. i -1]
|
|
]
|
|
, afterRecoil (fromIntegral i * 5)
|
|
, torqueBefore (fromIntegral i * 0.05)
|
|
, withSidePushI (fromIntegral i * 25)
|
|
, withMuzFlare
|
|
, withSmoke 1 black 20 200 5
|
|
, useAmmoAmount i
|
|
, withSoundForI mini1S 2
|
|
, withWarmUp crankSlowS
|
|
, ammoCheckI
|
|
]
|
|
SmgMod ->
|
|
[ withFlare
|
|
, withSidePushI 30
|
|
, withRecoil
|
|
, withTorqueAfter
|
|
, duplicateLoadedBarrels
|
|
, withSoundStart tap3S
|
|
, useAmmoAmount 1
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
]
|
|
BangConeMod ->
|
|
[ withRandomItem coneRandItemParams
|
|
, withRandomItemUpdate coneRandItemUpdate
|
|
, withRandomOffset
|
|
, duplicateLoadedBarrels
|
|
, duplicateLoaded
|
|
, withMuzFlare
|
|
, withRecoil
|
|
, withTorqueAfter
|
|
, useAllAmmo
|
|
, withSoundStart bangEchoS
|
|
, useTimeCheck
|
|
, ammoCheckI
|
|
, blCheck
|
|
]
|
|
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 * lasWideRate) . (+ 1))
|
|
thegapDualBeam = _dbGap . _itParams
|
|
directedTelPos _ cr w = (p, a)
|
|
where
|
|
p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
|
|
a = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- p)
|
|
modcrpos x cr = fromMaybe cr $ do
|
|
invid <- cr ^? crManipulation . manObject . inInventory . ispItem
|
|
return $ cr & crDir %~ tweenAngles x (_crOldDir cr)
|
|
& crPos %~ alongSegBy x (_crOldPos cr)
|
|
& crInv . ix (invid + 1) . itUse . amagParams . ampBullet . buDelayFraction .~ x
|
|
|
|
lasWideRate :: Int
|
|
lasWideRate = 2
|
|
|
|
mcUseHeld :: HeldItemType -> Item -> Machine -> World -> World
|
|
mcUseHeld hit = case hit of
|
|
LASGUN -> mcShootLaser
|
|
_ -> \_ _ -> id
|
|
|
|
useHeld :: Huse -> [Item] -> Item -> Creature -> World -> World
|
|
useHeld hu = case hu of
|
|
HeldDoNothing -> const . 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
|
|
-- HeldSonicWave -> aSonicWave
|
|
HeldForceField -> const useForceFieldGun
|
|
HeldShatter -> const shootShatter
|
|
HeldExplodeRemoteShell itid pjid -> const $ 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
|
|
|
|
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 .)
|
|
|
|
overNozzles ::
|
|
(Nozzle -> [Item] -> Item -> Creature -> World -> World) ->
|
|
[Item] ->
|
|
Item ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
overNozzles = overNozzles' . overNozzle
|
|
|
|
overNozzles' ::
|
|
([Item] -> Item -> Creature -> World -> Nozzle -> (World, Nozzle)) ->
|
|
[Item] ->
|
|
Item ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
overNozzles' eff ams it cr w = neww & cWorld . lWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
|
|
where
|
|
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)
|
|
|
|
overNozzle ::
|
|
(Nozzle -> [Item] -> Item -> Creature -> World -> World) ->
|
|
[Item] ->
|
|
Item ->
|
|
Creature ->
|
|
World ->
|
|
Nozzle ->
|
|
(World, Nozzle)
|
|
overNozzle eff ams it cr w nz =
|
|
( eff nz ams 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)
|
|
|
|
getAmmoMagazine :: Item -> Creature -> Maybe ItemUse
|
|
getAmmoMagazine itm cr = do
|
|
invid <- itm ^? itLocation . ipInvID
|
|
amtype <- itm ^? itUse . heldAmmoTypes . ix 0
|
|
mag <- cr ^? crInv . ix (invid + 1) . itUse
|
|
magtype <- mag ^? amagType
|
|
guard $ amtype == magtype
|
|
return mag
|
|
|
|
useGasParams :: Nozzle -> [Item] -> Item -> Creature -> World -> World
|
|
useGasParams nz ams _ cr =
|
|
createGas
|
|
gastype
|
|
(_nzPressure nz)
|
|
pos
|
|
dir
|
|
cr
|
|
where
|
|
gastype = fromMaybe (error "cannot find gas ammo") $ ams ^? ix 0 . 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
|
|
|
|
caneStickSoundChoice :: Item -> SoundID
|
|
caneStickSoundChoice _ = tap3S
|
|
-- -- | (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded) < 2 = tap3S
|
|
-- -- | otherwise = shotgunS
|
|
|
|
bangStickSoundChoice :: Item -> SoundID
|
|
bangStickSoundChoice = caneStickSoundChoice
|
|
|
|
coneRandItemUpdate :: State StdGen (Item -> Item)
|
|
coneRandItemUpdate = return id
|
|
-- do
|
|
-- wth <- state $ randomR (1, 5)
|
|
-- return (itUse . heldConsumption . laAmmoType . amBullet . buWidth .~ wth)
|
|
|
|
coneRandItemParams :: State StdGen (Item -> Item)
|
|
coneRandItemParams = do
|
|
muzv <- state $ randomR (0.5, 1)
|
|
rifl <- state $ randomR (0.3, 0.9)
|
|
return $ \it ->
|
|
it & itUse . heldParams . muzVel .~ muzv
|
|
& itUse . heldParams . 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] -> Item -> Creature -> World -> World
|
|
shootTeslaArc _ it cr w =
|
|
w'
|
|
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
|
|
where
|
|
itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
|
|
(w', ip) = makeTeslaArc (_itParams it) pos dir w
|
|
pos = _crPos cr +.+ aimingMuzzleLength cr it *.* unitVectorAtAngle dir
|
|
dir = _crDir cr
|
|
|
|
-- I believe because the targeting returns to nothing straight after you release
|
|
-- the rmb, it is possible for this to do nothing
|
|
-- TODO investigate more and fix
|
|
useForceFieldGun :: Item -> Creature -> World -> World
|
|
useForceFieldGun itm cr w = fromMaybe w $ do
|
|
a <- cr ^? crTargeting . ctPos . _Just
|
|
let mwp = mouseWorldPos (w ^. input) (w ^. wCam)
|
|
b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
|
|
wlline = (a, b)
|
|
return $
|
|
w
|
|
& cWorld . lWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
|
|
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itLocation itm)) . itParams . paramMID ?~ i
|
|
& moveWallIDUnsafe i wlline
|
|
where
|
|
i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just
|