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

import qualified Data.IntMap.Strict as IM
import qualified Streaming.Prelude as S
import Data.Maybe
import Dodge.Movement.Turn
import Dodge.WorldEvent.ThingsHit
import Control.Monad.State
import System.Random
--import Data.Bifunctor

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

useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World
useAmmoParams vfact it cr w = w & instantBullets .:~ (_amBullet bultype
    & buPos .~ sp 
    & buTrajectory %~ settrajectory
    & buVel %~ (rotateV dir . (muzvel *.*))
    & buDrag *~ _rifling (_itParams it)
    & buState %~ setstate
    )
  where
    setstate = case vfact of
        Nothing -> id
        Just x  -> const $ DelayedBullet x
    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 :: World -> Bullet -> (World, Maybe Bullet)
mvBullet w bt' 
    | t <= 0 || magV (_buVel bt) < 1 = (w,Nothing)
    | otherwise = bimap (maybespawn . maybebounce) (fmap dodrag) $ 
        hiteff bt hitstream w
  where
    maybespawn w' = fromMaybe w' $ do
        (hp,_) <- runIdentity (S.head_ hitstream)
        partspawn <- bulletSpawn bt'
        let (thepart,g) = runState (partspawn hp) $ _randGen w'
        return $ w' & instantParticles .:~ thepart
            & randGen .~ g
    maybebounce = fromMaybe id $ do
        guard (_buEffect bt' == BounceBullet)
        (hp,crwl) <- runIdentity (S.head_ hitstream)
        dir <- bounceDir (hp,crwl)
        return $ instantBullets .:~ (bt
            & buPos .~ hp +.+ (normalizeV (_buPos bt' -.- hp))
            & buVel %~ reflectIn dir
            & buTrajectory .~ BasicBulletTrajectory
            & buTimer -~ 1
            )
    --maybebounce = case _buEffect bt' of
    --    BounceBullet -> case runIdentity (S.head_ hitstream) of
    --        Just (hp, Left cr) | crIsArmouredFrom hp cr -> instantBullets .:~ bouncer
    --          where
    --            bouncer = bt
    --                & buPos .~ pOut 
    --                & buVel .~ reflectVel 
    --                & buTrajectory .~ BasicBulletTrajectory
    --                & buTimer -~ 1
    --            pOut = hp +.+ 2 *.* newDir
    --            reflectVel = reflectIn newDir bulVel --magV bulVel *.* newDir
    --            newDir = squashNormalizeV (hp -.- _crPos cr)
    --            bulVel = _buVel bt
    --        Just (hp, Right wl) -> instantBullets .:~ bouncer
    --          where
    --            reflectVel = reflVelWall wl (_buVel bt)
    --            bouncer = bt
    --                & buPos .~ pOut 
    --                & buVel .~ reflectVel 
    --                & buTrajectory .~ BasicBulletTrajectory
    --                & buTimer -~ 1
    --            pOut = hp +.+ squashNormalizeV (p -.- hp)
    --        _ -> id
    --    _ -> id
    hitstream = thingsHit p (p +.+ vel) w
    bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
    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
    t       = _buTimer bt

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

bulletSpawn :: Bullet -> Maybe (Point2 -> State StdGen Particle)
bulletSpawn bu = case _buSpawn bu of
    BulSpark -> Nothing
    BulBall IncBall -> Just incBall
    BulBall ConcBall -> Just concBall
    BulBall TeslaBall -> Just aStaticBall

hitEffFromBul :: Bullet
    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
    -> World 
    -> (World,Maybe Bullet)
hitEffFromBul = expireAndDamage' setfromtodams
  where
    setfromtodams bu p = map f (_buDamages bu)
      where
        f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)

mvBulletSlow :: Float -> World -> Bullet -> (World, Maybe Bullet)
mvBulletSlow x w bt' 
    | t <= 0 || magV (_buVel bt) < 1 = (w,Nothing)
    | otherwise = second (fmap dodrag) $ 
        hiteff bt (thingsHit p (p +.+ vel) w) w
  where
    bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
    dodrag = (buVel .*.*~ drag)
        . (buState .~ NormalBulletState)
    drag = _buDrag bt
    p       = _buPos bt
    vel     = x *.* _buVel bt
    hiteff  = hitEffFromBul
    t       = _buTimer bt
expireAndDamage' :: (Bullet -> Point2 -> [Damage])
    -> Bullet
    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
    -> World
    -> (World, Maybe Bullet)
expireAndDamage' fdm bt things w = case runIdentity $ S.head_ things of
    Nothing -> (w, moveBullet bt)
    Just x -> (doDamages' fdm x bt w, destroyAt' (fst x) bt)

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

destroyAt' :: Point2 -> Bullet -> Maybe Bullet
destroyAt' hitp pt = Just $ pt 
    & buState  .~ DyingBulletState
    & buPos     .~ hitp
    & buOldPos  .~ _buPos pt
    & buTimer   %~ (min 3 . subtract 1)

--penWalls 
--    :: HitCreatureEffect' 
--    -> HitWallEffect' 
--    -> Bullet 
--    -> [(Point2, Either Creature Wall)] 
--    -> World 
--    -> (World, Maybe Bullet)
--penWalls crEff wlEff pt hitThings w = case hitThings of
--    []              -> (              w, moveBullet pt)
--    ((p,Left cr):_) -> (crEff pt p cr w, destroyAt' p pt)
--    ((p,Right wl):hs) | _wlFireThrough wl 
--                    -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w
--    ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt' p pt)

--type HitCreatureEffect'   = Bullet -> Point2 -> Creature   -> World -> World
--type HitWallEffect'       = Bullet -> Point2 -> Wall       -> World -> World

doDamages' :: (Bullet -> Point2 -> [Damage])
    -> (Point2, Either Creature Wall)
    -> Bullet
    -> World
    -> World
doDamages' fdm (p,thhit) bt = case thhit of
    Left cr -> creatures . ix (_crID cr) . crState . csDamage .++~ dams
    Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams
  where
    dams = fdm bt p

--penetrate 
--    :: ((Point2,Either Creature Wall) -> Bullet -> Maybe Bullet) 
--        -- | penetration test, can update particle if it penetrates
--    -> (Bullet -> Point2 -> [Damage]) -- | damages when penetrating
--    -> (Bullet -> Point2 -> [Damage]) -- | damages when not penetrating
--    -> Bullet
--    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
--    -> World
--    -> (World, Maybe Bullet)
--penetrate t pendam stopdam pt hitThings w = case runIdentity $ S.uncons hitThings of
--    Nothing -> (w, moveBullet pt)
--    Just (x,xs) -> case t x pt of
--        Nothing -> expireAndDamage' stopdam pt hitThings w
--        Just pt' -> first (doDamages' pendam x pt) $ penetrate t pendam stopdam pt' xs w