loop/src/Dodge/Bullet.hs

module Dodge.Bullet (
    updateBullet,
) where

import Data.Bifunctor
import Data.Foldable
import Data.Maybe
import Dodge.Creature.Test
import Dodge.Data.World
import Dodge.EnergyBall
import Dodge.Item.Weapon.Bullet
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 System.Random

updateBullet :: World -> Bullet -> (World, Maybe Bullet)
updateBullet w bu
    | magV (_buVel bu) < 1 = (useBulletPayload bu (_buPos bu) w, Nothing)
    -- have to be slightly carefull not to accelerate bullets using magnets
    | otherwise = second (Just . updateBulVel) . hitEffFromBul w $ applyMagnetsToBul bu w

-- do we want this to drain energy from the deflection source?
applyMagnetsToBul :: Bullet -> World -> Bullet
applyMagnetsToBul bu = foldl' doMagnetBuBu bu . _oldMagnets . _lWorld . _cWorld

doMagnetBuBu :: Bullet -> Magnet -> Bullet
doMagnetBuBu bu mg
    | notclose = bu
    | otherwise = case _mgField mg of
        MagnetAlign -> doturntowards mgalignpos
        MagnetDeflect -> doturntowards mgdeflectpos
        MagnetAttract -> doturntowards mpos
        MagnetRepulse -> doturntowards (2 * bpos - mpos)
  where
    notclose = d > 100
    doturntowards p = bu & buVel %~ vecTurnTo (10 * pi / (d + 40)) bpos p
    bvel = bu ^. buVel
    mpos = mg ^. mgPos
    bpos = bu ^. buPos
    mgdeflectpos
        | isLHS mpos (mpos + bvel) bpos = bpos + vNormal (bpos - mpos)
        | otherwise = bpos - vNormal (bpos - mpos)
    mgalignpos
        | dotV bvel (bpos - mpos) > 0 = bpos - mpos
        | otherwise = mpos - bpos
    d = dist (bu ^. buPos) (mg ^. mgPos)

updateBulVel :: Bullet -> Bullet
updateBulVel bt = bt & buVel .*.*~ _buDrag 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

-- NOTE THE FOLLOWING HAS BEZIER CURE/FLECHETTE STUFF THAT MIGHT BE USEFUL
--shootBullet :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
--shootBullet itm cr w = fromMaybe (error "cannot find bullet ammo when expected to") $ do
--    atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0
--    leftitms <- itm ^? ldtLeft
--    mag <- lookup (AmmoInLink 0 atype) leftitms
--    thebullet <- mag ^? ldtValue . itUse . amagParams . ampBullet
--    return $ w
--        & randGen .~ g'
--        & cWorld . lWorld . instantBullets
--        .:~ ( thebullet
--                & buPos .~ _crPos cr
--                & buTrajectory %~ settrajectory
--                & buVel %~ (rotateV dir . (muzvel *.*))
--                & buDrag *~ drag
--            )
--  where
--    it = itm ^. ldtValue
--    sp = _crPos cr +.+ (muzlength ^?! _head . _x) *.* unitVectorAtAngle dir
--    dir = _crDir cr
--    (drag,g) = case _rifling (_heldParams $ _itUse it) of
--        ConstFloat x -> (x, _randGen w)
--        UniRandFloat x y -> randomR (x,y) $ _randGen w
--    (muzvel,g') = case _muzVel $ _heldParams $ _itUse it of
--        ConstFloat x -> (x,g)
--        UniRandFloat x y -> randomR (x,y) $ _randGen w
--    muzlength = aimingMuzzlePos cr it
--    settrajectory traj = case traj of
--        BasicBulletTrajectory -> BasicBulletTrajectory
--        MagnetTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
--            tpos <- cr ^? crTargeting . ctPos . _Just
--            return $ MagnetTrajectory tpos
--        FlechetteTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
--            tpos <- cr ^? crTargeting . ctPos . _Just
--            return $ FlechetteTrajectory tpos
--        BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
--            tpos <- cr ^? crTargeting . ctPos . _Just
--            return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. wCam))

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

useBulletPayload :: Bullet -> Point2 -> World -> World
useBulletPayload bu = case _buPayload bu of
    BulSpark -> const id
    BulFlak -> makeFlak bu
    BulFrag -> makeFragBullets
    BulGas -> (`makeGasCloud` V2 0 0)
    BulBall IncBall -> incBallAt
    BulBall ConcBall -> \p -> cWorld . lWorld . shockwaves .:~ concBall p
    BulBall TeslaBall -> makeStaticBall
    BulBall FlashBall -> makeFlashBall

makeFragBullets :: Point2 -> World -> World
makeFragBullets p w = w & cWorld . lWorld . bullets .++~ bus
  where
    bus = zipWith f (take 10 as) (take 10 ss)
    as = randomRs (0, 2 * pi) $ _randGen w
    ss = randomRs (5, 15) $ _randGen w
    f a s =
        defaultBullet & buVel .~ s *.* unitVectorAtAngle a
            & buDrag .~ 0.8
            & buPos .~ p
            & buOldPos .~ p
            & buWidth .~ 1
            & buDamages .~ [Damage PIERCING 5 0 0 0 $ PushBackDamage 2]

makeFlak :: Bullet -> Point2 -> World -> World
makeFlak bu _ w = w & cWorld . lWorld . bullets .++~ [f x | x <- xs]
  where
    s = min 10 (0.5 * magV (_buVel bu))
    xs = take 5 $ randomRs (- s, s) $ _randGen w
    f x = bu & buVel %~ g x
            & buPayload .~ BulSpark
            & buWidth .~ 0.5
            & buDamages .~ [Damage PIERCING 25 0 0 0 $ PushBackDamage 2]
    g x v = v +.+ x *.* normalizeV (vNormal v)

hitEffFromBul :: World -> Bullet -> (World, Bullet)
hitEffFromBul w bu = case _buEffect bu of
    PenetrateBullet -> movePenBullet bu hitstream w
    BounceBullet -> fromMaybe (expireAndDamage bu hitstream w) $ do
        (hp, crwl) <- hitstream ^? _head
        dir <- bounceDir (hp, crwl)
        return
            ( w
            , bu
                & buPos .~ hp + normalizeV (_buPos bu - hp)
                & buVel %~ reflectIn dir
            )
    DestroyBullet -> expireAndDamage bu hitstream w
  where
    sp = _buPos bu
    hitstream = thingsHit sp (sp + _buVel bu) 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 . lWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
    --    Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
    --    hopefully the following doesn't introduce a space leak
    Right wl -> cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty <>~ dams
  where
    dams = setFromToDams bu p

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

moveBullet :: Bullet -> Bullet
moveBullet pt = pt & buPos +~ _buVel pt & buOldPos .~ _buPos pt

stopBulletAt :: Point2 -> Bullet -> Bullet
stopBulletAt hitp pt =
    pt
        & buPos .~ hitp
        & buOldPos .~ _buPos pt
        & buVel .~ 0

movePenBullet :: Bullet -> [(Point2, Either Creature Wall)] -> World -> (World, Bullet)
movePenBullet bu hitstream w = case hitstream of
    [] -> (w, moveBullet bu)
    ((p, crwl) : strm) | penThing crwl ->
            first (damageThingHit bu (p, crwl)) $ movePenBullet bu strm w
    _ -> expireAndDamage bu hitstream w

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