loop/src/Dodge/Bullet.hs

module Dodge.Bullet 
    ( updateBullet
    , useAmmoParams
    ) where
import qualified ListHelp as List
import Dodge.EnergyBall
import Dodge.Creature.Test
import Dodge.Data
import Dodge.Creature.HandPos
import Dodge.Base.Coordinate
import Dodge.WorldEvent.SpawnParticle
import Geometry
import LensHelp
import StreamingHelp

import qualified IntMapHelp as IM
import Data.Maybe
import Dodge.Movement.Turn
import Dodge.WorldEvent.ThingsHit

updateBullet :: World -> Bullet -> (World,Maybe Bullet)
updateBullet w bu = case _buState bu of
    DelayedBullet x -> mvBullet x w bu
    _ -> mvBullet 1 w bu

useAmmoParams :: Item -> Creature -> World -> World
useAmmoParams it cr w = w & 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 $ _itConsumption 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)

{- Update for a generic bullet.  -}
mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet)
mvBullet x w bt' 
    | t <= 0 || magV (_buVel bt) < 1 = (endspawn w,Nothing)
    | otherwise = second (fmap dodrag) $ 
        hiteff bt hitstream w
  where
    endspawn w' = fromMaybe w' $ do
        partspawn <- bulletSpawn bt'
        return $ partspawn p w'
    hitstream = thingsHit p (p +.+ vel) w
    bt = foldr (\mg b -> _mgField mg mg b) bt' (_magnets w)
        & buState .~ NormalBulletState
    dodrag = case _buTrajectory bt of
        BasicBulletTrajectory -> buVel .*.*~ drag
        MagnetTrajectory tpos -> buVel .+.+~ 5 *.* normalizeV (tpos -.- _buPos bt)
        FlechetteTrajectory tpos -> buVel %~ vecTurnTo 0.2 (_buPos bt) tpos
        BezierTrajectory spos tpos xpos -> 
            let bf tm = bQuadToF (spos,xpos,tpos) $ (100 - tm) * 0.05
            in buVel .~ bf (fromIntegral $ _buTimer bt - 1) -.- bf (fromIntegral $ _buTimer bt)
    drag = _buDrag bt
    p       = _buPos bt
    vel     = _buVel bt
    hiteff  = hitEffFromBul x
    t       = _buTimer bt

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 $ randParticleAt concBall
    BulBall TeslaBall -> Just makeStaticBall

hitEffFromBul :: Float -> Bullet
    -> [(Point2, Either Creature Wall)]
    -> World 
    -> (World,Maybe Bullet)
hitEffFromBul x bu hitstream w = 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

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 -> creatures . ix (_crID cr) . crState . csDamage .++~ dams
    Right wl -> 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