loop/src/Dodge/Bullet.hs

module Dodge.Bullet (
    updateBullet,
    useAmmoParams,
) where

import Data.Foldable
import Data.Maybe
import Dodge.Base.Coordinate
import Dodge.Creature.HandPos
import Dodge.Creature.Test
import Dodge.Data.World
import Dodge.EnergyBall
import Dodge.MagnetBuBu
import Dodge.Movement.Turn
import Dodge.WorldEvent.SpawnParticle
import Dodge.WorldEvent.ThingsHit
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import qualified ListHelp as List
import Data.Bifunctor

updateBullet :: World -> Bullet -> (World, Maybe Bullet)
updateBullet w bu = case _buDelayFraction bu of
    1 -> mvBullet 1 w bu
    x -> mvBullet x w (bu & buDelayFraction .~ 1)

mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet)
mvBullet x w bu
    | _buTimer bu <= 0 || magV (_buVel bu) < 1 = (endspawn w, Nothing)
    | otherwise =
        second (fmap updateBulVel)
            . hitEffFromBul x w
            $ applyMagnetsToBul bu w
  where
    endspawn = fromMaybe id $ do
        partspawn <- bulletSpawn bu
        return $ partspawn p
    p = _buPos bu

applyMagnetsToBul :: Bullet -> World -> Bullet
applyMagnetsToBul bu =
    foldl' (flip doMagnetBuBu) bu . _magnets . _cWorld

updateBulVel :: Bullet -> Bullet
updateBulVel bt = case _buTrajectory bt of
    BasicBulletTrajectory -> bt & buVel .*.*~ _buDrag bt
    MagnetTrajectory tpos -> bt & buVel %~ (clipV 20 . (+.+ 5 *.* normalizeV (tpos -.- _buPos bt)))
    FlechetteTrajectory tpos -> bt & buVel %~ vecTurnTo 0.2 (_buPos bt) tpos
    BezierTrajectory spos tpos xpos ->
        let bf tm = bQuadToF (spos, xpos, tpos) $ (100 - tm) * 0.05
         in bt & buVel .~ bf (fromIntegral $ t - 1) -.- bf (fromIntegral t)
  where
    t = _buTimer bt

useAmmoParams :: Item -> Creature -> World -> World
useAmmoParams it cr w =
    w & cWorld . instantBullets
        .:~ ( _amBullet bultype
                & buPos .~ sp
                & buTrajectory %~ settrajectory
                & buVel %~ (rotateV dir . (muzvel *.*))
                & buDrag *~ _rifling (_itParams it)
            )
  where
    sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
    dir = _crDir cr
    bultype = _laAmmoType $ _heldConsumption $ _itUse it
    muzvel = _muzVel $ _itParams it
    muzlength = aimingMuzzlePos cr it
    settrajectory traj = case traj of
        BasicBulletTrajectory -> BasicBulletTrajectory
        MagnetTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
            tpos <- it ^? itTargeting . tgPos . _Just
            return $ MagnetTrajectory tpos
        FlechetteTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
            tpos <- it ^? itTargeting . tgPos . _Just
            return $ FlechetteTrajectory tpos
        BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
            tpos <- it ^? itTargeting . tgPos . _Just
            return $ BezierTrajectory sp tpos (mouseWorldPos w)

bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2
bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl)
bounceDir (p, Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
bounceDir _ = Nothing

bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World)
bulletSpawn bu = case _buSpawn bu of
    BulSpark -> Nothing
    BulBall IncBall -> Just incBallAt
    BulBall ConcBall -> Just $ \p -> cWorld . shockwaves .:~ concBall p
    BulBall TeslaBall -> Just makeStaticBall

hitEffFromBul ::
    Float ->
    World ->
    Bullet ->
    (World, Maybe Bullet)
hitEffFromBul x w bu = case _buEffect bu of
    PenetrateBullet -> movePenBullet x bu hitstream w
    BounceBullet -> case List.safeHead hitstream of
        Nothing -> (w, moveBullet x bu)
        Just (hp, crwl) -> fromMaybe (expireAndDamage x bu hitstream w) $ do
            dir <- bounceDir (hp, crwl)
            return
                ( w
                , Just $
                    bu
                        & buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
                        & buVel %~ reflectIn dir
                        & buTrajectory .~ BasicBulletTrajectory
                        & buTimer -~ 1
                )
    DestroyBullet -> expireAndDamage x bu hitstream w
  where
    ep = sp +.+ x *.* _buVel bu
    sp = _buPos bu
    hitstream = thingsHit sp ep w

setFromToDams :: Bullet -> Point2 -> [Damage]
setFromToDams bu p = map f (_buDamages bu)
  where
    f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)

damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World
damageThingHit bu (p, crwl) = case crwl of
    Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
    Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
  where
    dams = setFromToDams bu p

expireAndDamage ::
    Float ->
    Bullet ->
    [(Point2, Either Creature Wall)] ->
    World ->
    (World, Maybe Bullet)
expireAndDamage y bt things w = case List.safeHead things of
    Nothing -> (w, moveBullet y bt)
    Just x -> (damageThingHit bt x w, destroyAt (fst x) bt)

moveBullet :: Float -> Bullet -> Maybe Bullet
moveBullet x pt =
    Just $
        pt
            & buPos %~ (+.+ x *.* _buVel pt)
            & buOldPos .~ _buPos pt
            & buTimer -~ 1

destroyAt :: Point2 -> Bullet -> Maybe Bullet
destroyAt hitp pt =
    Just $
        pt
            & buPos .~ hitp +.+ normalizeV (p -.- hitp)
            & buOldPos .~ p
            & buVel .~ 0
  where
    p = _buPos pt

movePenBullet ::
    Float ->
    Bullet ->
    [(Point2, Either Creature Wall)] ->
    World ->
    (World, Maybe Bullet)
movePenBullet x bu hitstream w = case hitstream of
    [] -> (w, moveBullet x bu)
    ((p, crwl) : strm) ->
        if penThing crwl
            then first (damageThingHit bu (p, crwl)) $ movePenBullet x bu strm w
            else expireAndDamage x bu hitstream w

penThing :: Either Creature Wall -> Bool
penThing (Left _) = True
penThing (Right wl) = _wlPenetrable wl