Files
loop/src/Dodge/HeldUse.hs
T
2024-09-22 14:29:02 +01:00

495 lines
20 KiB
Haskell

{-# LANGUAGE TupleSections #-}
module Dodge.HeldUse
-- ( heldEffect
-- , mcUseHeld
-- )
where
import Dodge.Base.Collide
import Dodge.Inventory.Lock
--import Dodge.WorldEvent.Cloud
import Dodge.LightSource
import qualified SDL
--import Dodge.Base.You
import Dodge.Data.MuzzleEffect
import ListHelp
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
--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
--import Data.Foldable
heldEffect :: HeldMod -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
heldEffect effecttype = case effecttype of
PistolMod -> bulGunEffect
FireRemoteShellMod -> undefined
ExplodeRemoteShellMod -> undefined
DoNothingMod -> const $ const id
where
bulGunEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
bulGunEffect = hammerCheck $ useTimeCheck bulGunEffect'
bulGunEffect' :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
bulGunEffect' t cr w = fromMaybe (error "error in bulGunEffect") $ do
muzzles <- t ^? ldtValue . itUse . heldAim . aimMuzzles
let (upitm,loadedmuzzles) = mapAccumR loadMuzzle t muzzles
cmew = foldl' (useLoadedAmmo (_ldtValue t) cr) (CME 0 0 False,w) $ zip [0..] loadedmuzzles
return $ uncurry (applyCME (_ldtValue t) cr) cmew
& cWorld . lWorld . lTestString .~ map (show . _mzAmmoSlot) muzzles
& doWeaponRepetitions upitm cr
-- & cWorld . lWorld . lTestInt +~ 1
doWeaponRepetitions :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
doWeaponRepetitions itm cr = case itm ^? ldtValue . itUse . heldParams . weaponRepeat of
Just (x:xs) -> cWorld . lWorld . delayedEvents .++~ ((x:xs) <&> (,WdWdFromItCrixWdWd upitm (_crID cr) ItCrWdItemEffect))
_ -> id
where
upitm = itm & ldtValue . itUse . heldParams . weaponRepeat .~ []
& ldtValue . itUse . heldTriggerType .~ AutoTrigger
applyCME :: Item -> Creature -> CumulativeMuzzleEffect -> World -> World
applyCME itm cr cme
| _cmeSound cme = applyInvLock itm cr . applySoundCME itm cr . applySidePush spush cr . applyTorqueCME itm cr . applyRecoil itm cr
| otherwise = failsound
where
spush = fromMaybe 0 $ itm ^? itUse . heldParams . sidePush
failsound w = case w ^? input . mouseButtons . ix SDL.ButtonLeft of
Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w
_ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w
applyInvLock :: Item -> Creature -> World -> World
applyInvLock itm cr = case itm ^? itUse . heldParams . weaponInvLock of
Just i | i > 0 -> (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv cid))
. lockInv cid
_ -> id
where
cid = _crID cr
applySoundCME :: Item -> Creature -> World -> World
applySoundCME itm cr = fromMaybe id $ do
(soundid,x) <- itm ^? itUse . heldParams . bulGunSound . _Just
if x > 0
then return $ soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) soundid (Just x)
else return $ soundMultiFrom [CrWeaponSound cid j | j <- [0..5]] (_crPos cr) soundid Nothing
where
cid = _crID cr
applyRecoil :: Item -> Creature -> World -> World
applyRecoil itm cr = over (cWorld . lWorld . creatures . ix cid) pushback
where
cid = _crID cr
recoilAmount = fromMaybe 0 $ itm ^? itUse . heldParams . recoil
pushback = over crPos (+.+ rotateV (_crDir cr) (V2 ((- recoilAmount) / _crMass cr) 0))
applySidePush :: Float -> Creature -> World -> World
applySidePush 0 _ w = w
applySidePush maxSide cr w = w
& cWorld . lWorld . creatures . ix cid %~ push
& randGen .~ g
where
cid = _crID cr
push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)))
(pushAmount, g) = randomR (- maxSide, maxSide) $ _randGen w
applyTorqueCME :: Item -> Creature -> World -> World
applyTorqueCME itm cr w
| cid == 0 = w
& wCam . camRot -~ rot
& cWorld . lWorld . creatures . ix cid . crDir +~ rot
& randGen .~ g
| otherwise = w
& cWorld . lWorld . creatures . ix cid . crDir +~ rot
& randGen .~ g
where
cid = _crID cr
(rot, g) = randomR (- torque, torque) $ _randGen w
torque = fromMaybe 0 $ itm ^? itUse . heldParams . torqueAfter
-- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
loadMuzzle :: LabelDoubleTree ComposeLinkType Item
-> Muzzle -> (LabelDoubleTree ComposeLinkType Item,(Muzzle, Int,Maybe Int))
loadMuzzle t@(LDT _ l _) mz = fromMaybe (t,(mz, 0,Nothing)) $ do
let as = _mzAmmoSlot mz
amamount = 1
(i,(_,mag)) <- findWithIx (isAmmoIntLink as . fst) l
availableammo <- mag ^? ldtValue . itUse . amagLoadStatus . iaLoaded
let usedammo = min amamount availableammo
return (t & ldtLeft . ix i . _2 . ldtValue . itUse . amagLoadStatus . iaLoaded -~ usedammo
, (mz, usedammo, mag ^? ldtValue . itLocation . ilInvID)
)
makeMuzzleFlare :: Muzzle -> Item -> Creature -> World -> World
makeMuzzleFlare mz itm cr = case mz ^. mzFlareType of
DefaultFlareType -> id
PistolFlare -> basicMuzFlare pos dir
MiniGunFlare -> makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (pos `v2z` 20)
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
HeavySmokeFlare -> basicMuzFlare pos dir
LasGunFlare -> flareCircleAt (_lasColor $ _itParams itm) 0.8 (pos `v2z` 20)
. (cWorld . lWorld . tempLightSources .:~
tlsTimeRadColPos 1 100 (xyzV4 . _lasColor $ _itParams itm) (pos `v2z` 10))
TeslaGunFlare -> cWorld . lWorld . tempLightSources .:~
tlsTimeRadColPos 1 100 (V3 0 0 1) (pos `v2z` 10)
where
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
dir = _crDir cr + _mzRot mz
basicMuzFlare :: Point2 -> Float -> World -> World
basicMuzFlare pos dir = makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (pos `v2z` 20)
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
---- need to add these to muzzle flare?
--makeMuzzleSmoke :: Muzzle -> Item -> Creature -> World -> World
--makeMuzzleSmoke mz itm cr w = case mz ^. mzFlareType of
-- DefaultFlareType -> w
-- PistolFlare -> foldl' (flip $ smokeCloudAt (greyN 0.5) 5 400 5 . (+.+.+ pos) . (* 8)) w ps
-- MiniGunFlare -> smokeCloudAt (greyN 0.5) 5 400 5 pos w
-- HeavySmokeFlare -> foldl' (flip $ smokeCloudAt black 20 400 5 . (+.+.+ pos) . (* 8)) w ps'
-- LasGunFlare -> w
-- TeslaGunFlare -> w
-- where
-- ps = replicateM 2 randOnUnitSphere & evalState $ _randGen w
-- ps' = replicateM 4 randOnUnitSphere & evalState $ _randGen w
-- pos = addZ 10 $ _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
---- , withSmoke 1 black 20 200 5
isAmmoIntLink :: Int -> ComposeLinkType -> Bool
isAmmoIntLink i (AmmoInLink j _) = i == j
isAmmoIntLink _ _ = False
useLoadedAmmo :: Item -> Creature -> (CumulativeMuzzleEffect,World) -> (Int,(Muzzle,Int,Maybe Int))
-> (CumulativeMuzzleEffect,World)
useLoadedAmmo _ _ (cme,w) (_,(_,0,_)) = (cme, w)
useLoadedAmmo itm cr (cme,w) (mzid,(mz,x,mid)) = (,) (cme & cmeSound .~ True) $
removeAmmoFromMag x mid cr . makeMuzzleFlare mz itm cr $ case _mzEffect mz of
MuzzleShootBullet -> shootBullet itm cr w (mz,x,mid)
MuzzleLaser -> shootLaser' itm cr mz w
MuzzleTesla -> shootTeslaArc itm cr mz w
MuzzleTractor -> shootTractorBeam itm cr w
MuzzleLauncher -> createProjectile mid mz itm cr w
MuzzleNozzle {} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
MuzzleShatter -> shootShatter itm cr w
MuzzleForceField -> useForceFieldGun itm cr w
MuzzleDetector -> itemDetectorEffect itm cr w
itemDetectorEffect :: Item -> Creature -> World -> World
itemDetectorEffect itm cr w = fromMaybe w $ do
HELDDETECTOR dt <- itm ^? itType . iyBase . ibtHeld
return $ detectorEffect dt itm cr w
walkNozzle :: Int -> Muzzle -> Item -> Creature -> World -> World
walkNozzle mzid mz itm cr w = fromMaybe w $ do
invid <- itm ^? itLocation . ilInvID
return $ w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv
. ix invid . itUse . heldAim . aimMuzzles . ix mzid . mzEffect . nzCurrentWalkAngle .~ wa
& randGen .~ g
where
nz = _mzEffect mz
(walkamount, g) = randomR (- aspeed, aspeed) (_randGen w)
aspeed = _nzWalkSpeed nz
maxa = _nzMaxWalkAngle nz
wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + walkamount)
shootTractorBeam :: Item -> Creature -> World -> World
shootTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt' spos outpos dir power
where
cpos = _crPos cr
spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
dir = _crDir cr
outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
power = _attractionPower . _itParams $ _crInv cr IM.! itRef
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
tractorBeamAt' :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
tractorBeamAt' pos outpos dir power =
TractorBeam
{ _tbPos = pos
, _tbStartPos = outpos
, _tbVel = d
, _tbTime = 10
}
where
d = unitVectorAtAngle dir * power
shootLaser' :: Item -> Creature -> Muzzle -> World -> World
shootLaser' itm cr mz w = w
& randGen .~ g
&
cWorld . lWorld . lasers
.:~ lasRayAt
(_lasColor $ _itParams itm)
(_lasDamage $ _itParams itm)
(_phaseV $ _itParams itm)
pos
dir
where
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
(a,g) = randomR (-inacc,inacc) $ _randGen w
inacc = _mzInaccuracy mz
dir = _crDir cr + _mzRot mz + a
removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
removeAmmoFromMag x mid cr = fromMaybe id $ do
magid <- mid
return $ cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix magid . itUse . amagLoadStatus . iaLoaded -~ x
shootBullet :: Item -> Creature -> World -> (Muzzle,Int,Maybe Int) -> World
shootBullet itm cr w (mz,x,mid) = fromMaybe w $ do
magid <- mid
-- should be able to pass the magazine in from elsewhere?
thebullet <- cr ^? crInv . ix magid . itUse . amagParams . ampBullet
return $ w & flip (foldl' (&)) (replicate x (makeBullet thebullet itm cr mz))
-- & makeMuzzleFlare mz itm cr
-- & makeMuzzleSmoke mz itm cr
-- where
-- cid = _crID cr
-- the random generator is not updated here, not sure if that is a problem
makeBullet :: Bullet -> Item -> Creature -> Muzzle -> World -> World
makeBullet thebullet itm cr mz w =
w & randGen .~ g
& cWorld . lWorld . instantBullets
.:~ (thebullet
& buPos .~ bulpos
-- & buTrajectory .~ BasicBulletTrajectory
& buVel %~ (rotateV dir . (muzvel *.*))
& buDrag *~ drag
)
where
bulpos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm + V2 0 offset)
(a,g'') = randomR (-inacc,inacc) $ _randGen w
inacc = _mzInaccuracy mz
(drag,g') = case _rifling (_heldParams $ _itUse itm) of
ConstFloat x -> (x,g'')
UniRandFloat x y -> randomR (x,y) g''
(muzvel,g) = case _muzVel $ _heldParams $ _itUse itm of
ConstFloat x -> (x,g')
UniRandFloat x y -> randomR (x,y) g'
dir = _crDir cr + _mzRot mz + a
offset = case itm ^? itUse . heldParams . randomOffset of
Just x | x /= 0 -> fst . randomR (-x,x) $ _randGen w
_ -> 0
mcUseHeld :: HeldItemType -> Item -> Machine -> World -> World
mcUseHeld hit = case hit of
LASGUN -> mcShootLaser
_ -> \_ _ -> id
useHeld :: Huse -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
useHeld hu = case hu of
HeldDoNothing -> const $ const id
-- HeldUseAmmoParams -> shootBullet
-- HeldOverNozzlesUseGasParams -> overNozzles useGasParams
-- HeldPJCreation -> usePjCreation
-- HeldPJCreationX _ -> usePjCreationX
HeldFireRemoteShell -> fireRemoteShell
HeldDetectorEffect dt -> detectorEffect dt . _ldtValue
-- HeldTeslaArc -> shootTeslaArc . _ldtValue
-- HeldLaser -> shootLaser . _ldtValue
-- HeldCircleLaser -> circleLaser . _ldtValue
-- HeldDualLaser -> shootDualLaser . _ldtValue
HeldTractor -> aTractorBeam . _ldtValue
-- HeldSonicWave -> aSonicWave
HeldForceField -> useForceFieldGun . _ldtValue
HeldShatter -> shootShatter . _ldtValue
HeldExplodeRemoteShell itid pjid -> const $ const $ explodeRemoteRocket itid pjid
--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 0 atype) leftitms
-- apm <- mag ^? ldtValue
-- muz <- itm ^? ldtValue . itUse . heldAim . aimMuzzles . ix 0
-- return $ createProjectile apm muz (_ldtValue itm) cr
--usePjCreationX :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
--usePjCreationX = 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 -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) ->
-- LabelDoubleTree ComposeLinkType Item ->
-- Creature ->
-- World ->
-- World
--overNozzles = overNozzles' . overNozzle
--overNozzles' ::
-- (LabelDoubleTree ComposeLinkType Item -> Creature -> World -> Nozzle -> (World, Nozzle)) ->
-- LabelDoubleTree ComposeLinkType Item ->
-- Creature ->
-- World ->
-- World
--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 itm cr) w $ _sprayNozzles (_itParams it)
--overNozzle ::
-- (Nozzle -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) ->
-- LabelDoubleTree ComposeLinkType Item ->
-- Creature ->
-- World ->
-- Nozzle ->
-- (World, Nozzle)
--overNozzle eff itm cr w nz =
-- ( eff nz itm (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 :: Maybe Int -> Muzzle -> Item -> Creature -> World -> World
useGasParams mmagid mz itm cr w =
createGas
gastype
pressure
pos
dir
cr
w & randGen .~ g'
where
(pressure,g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w)
gastype = fromMaybe (error "cannot find gas ammo") $ do
magid <- mmagid
fueltype <- cr ^? crInv . ix magid . itUse . amagParams . ampCreateGas
gc <- itm ^? itUse . heldParams . gasCreation
return $ gasCreate fueltype gc
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
(a,g') = randomR (-inacc,inacc) g
inacc = _mzInaccuracy mz
dir = _crDir cr + _mzRot mz + a + (_nzCurrentWalkAngle $ _mzEffect mz)
gasCreate :: GasFuel -> GasCreate -> GasCreate
gasCreate = flip const
doGenFloat :: RandomGen g => GenFloat -> g -> (Float, g)
doGenFloat (ConstFloat x) g = (x,g)
doGenFloat (UniRandFloat x y) g = randomR (x,y) g
fireRemoteShell :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
fireRemoteShell = 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
-- -- | (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded) < 2 = tap3S
-- -- | otherwise = shotgunS
bangStickSoundChoice :: Item -> SoundID
bangStickSoundChoice = caneStickSoundChoice
-- 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 -> Creature -> Muzzle -> World -> World
shootTeslaArc itm cr mz w =
w'
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
where
itRef = cr ^?! crManipulation . manObject . inInventory . imRootItem -- unsafe!! TODO change
(w', ip) = makeTeslaArc (_itParams itm) pos dir w
pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
dir = _crDir cr + _mzRot mz
-- 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 (_ilInvID (_itLocation itm)) . itParams . paramMID ?~ i
& moveWallIDUnsafe i wlline
where
i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just