module Dodge.WorldEvent.Bullet
    where
import Dodge.Data
import Dodge.Base

import Dodge.WorldEvent.ThingsHit

import Picture
import Geometry

import Control.Lens

import Data.Maybe
import Data.List
import Data.Function (on)
import Data.Bifunctor
import qualified Data.IntMap.Strict as IM

mvBulletTrajectory :: (Int -> [Point2]) -> World -> Particle' -> (World, Maybe Particle')
mvBulletTrajectory velF w bt
    | t <= 0 = (w, Nothing)
    | t < 4  = (w, Just $ set btPassThrough' Nothing
                        $ set btTrail' (replicate numPs p ++ (p:ps) )
                        $ set ptPict' (bulLineLen numPs col wth (replicate numPs p ++ (p:ps) ) )
                        $ set btTimer' (t-1) 
                        bt                      
                )
    | otherwise = (w, Just  $ set btPassThrough' Nothing
                        $ set btVel' newVel -- this may be useful for hit effects
                        $ set btTrail' (init (reverse newPs) ++ (p:ps))
                        $ set ptPict' (bulLineLen numPs col wth (init (reverse newPs) ++ (p:ps)))
                        $ set btTimer' (t-1) bt                      
                    )
--    | otherwise = case firstThingHit $ thingsHitExceptCrCurve mcr (p:newPs) w of
--        (_,Nothing)  -> (w, Just  $ set btPassThrough' Nothing
--                        $ set btVel' newVel -- this may be useful for hit effects
--                        $ set btTrail' (init (reverse newPs) ++ (p:ps))
--                        $ set ptPict' (bulLineLen numPs col wth (init (reverse newPs) ++ (p:ps)))
--                        $ set btTimer' (t-1) bt                      
--                )
--        (mvPs,Just (hitp,thing)) 
--            -> let newMvPs = leftPad numPs hitp (init $ reverse mvPs)
--                   hitVel  = speed *.* normalizeV ( hitp -.- (head $ reverse mvPs) )
--               in  ( hiteff bt (hitp,thing) w
--               --in  ( w
--                   , Just  $ set btPassThrough' Nothing
--                           $ set btVel' hitVel -- this may be useful for hit effects
--                           $ set btTrail' (newMvPs ++ (p:ps))
--                           $ set ptPict' (bulLineLen numPs col wth (newMvPs ++ (p:ps)) )
--                           $ set btTimer' 3 bt                      
--                   )
  where mcr     = _btPassThrough' bt
        col     = _btColor' bt
        (p:ps)  = _btTrail' bt
        hiteff  = _btHitEffect' bt
        wth     = _btWidth' bt
        t       = _btTimer' bt
        newPs   = velF t
        numPs   = (length $ newPs) - 1
        firstThingHit :: [[(Point2,(Either3 Creature Wall ForceField))]] 
                            -> ([Point2], Maybe (Point2,Either3 Creature Wall ForceField))
        firstThingHit hitList = second last $ unzip $ zip newPs 
                                $ takeUntil isJust 
                                $ map listToMaybe hitList
        newVel  = speed *.* ( last newPs -.- (last $ init newPs) )
        speed   = sum . map magV $ zipWith (-.-) (init newPs) (tail newPs)


thingsHitExceptCrCurve :: Maybe Int -> [Point2] -> World 
                        -> [ [(Point2, (Either3 Creature Wall ForceField))]
                           ]
thingsHitExceptCrCurve mcid ps@(a:b:_) w 
                            = zipWith (\x y -> thingsHitExceptCr mcid x y w) ps $ tail ps
thingsHitExceptCrLine _ _ _ = []

thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World 
                        -> [(Point2, (Either3 Creature Wall ForceField))]
thingsHitExceptCr Nothing    sp ep = thingsHit sp ep
thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
    where crNotCid (_,(E3x1 cr)) = _crID cr /= cid
          crNotCid _ = True

mvGenBullet' :: World -> Particle' -> (World, Maybe Particle')
mvGenBullet' w bt 
    | t <= 0 = (w, Nothing)
    | t < 4  = (w, Just $ set btPassThrough' Nothing
                        $ set btTrail' (p:p:ps)
                        $ set ptPict' (bulLine col wth (p:p:ps))
                        $ set btTimer' (t-1) bt                      
                )
    | otherwise = hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
--        case thingsHitExceptCr mcr p (p +.+ vel) w of
--        []  -> (w, Just  $ set btPassThrough' Nothing
--                        $ set btTrail' (p +.+ vel :p:ps)
--                        $ set ptPict' (bulLine col wth (p +.+ vel:p:ps))
--                        $ set btTimer' (t-1) bt                      
--                )
--        hits -> hiteff bt hits w
  where mcr     = _btPassThrough' bt
        col     = _btColor' bt
        (p:ps)  = _btTrail' bt
        vel     = _btVel' bt
        hiteff  = _btHitEffect' bt
        wth     = _btWidth' bt
        t       = _btTimer' bt

bulLineLen :: Int -> Color -> Float -> [Point2] -> Picture
bulLineLen n c w ps = 
    setLayer 1 . onLayer HPtLayer $ color c $ thickLine (take (n * 2) ps) w

bulLine c w = setLayer 1 . bulLineb w

bulLineb :: Float -> [Point2] -> Picture
bulLineb w ps = color white $ thickLine (take 2 ps) w

bulLinea :: Color -> Float -> [Point2] -> Picture
bulLinea _ _ [] = blank
bulLinea _ _ (x:[]) = blank
bulLinea col width (a:b:[]) -- (a:b:[]) 
    = onLayer HPtLayer $ pictures $ reverse
        [polygonCol $ zip (wedgeGeom width b a) $ [white,withAlpha 0 white,withAlpha 0 white]
        ,polygonCol $ zip (lineGeom (width+1.5) a b) $ [col,col,withAlpha 0 col,withAlpha 0 col]
        ]
bulLinea col width (a:b:c:[]) -- (a:b:[]) 
    = onLayer HPtLayer $ pictures $ reverse
        [polygonCol $ zip (wedgeGeom width b a) $ repeat white
        ,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
        ,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
        ]
bulLinea col width (a:b:_:c:[]) -- (a:b:[]) 
    = onLayer HPtLayer $ pictures $ reverse
        [polygonCol $ zip (wedgeGeom width b a) $ repeat white
        ,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
        ,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
        ]
bulLinea col width (a:b:_:_:c:_) -- (a:b:[]) 
    = onLayer HPtLayer $ pictures $ reverse
        [polygonCol $ zip (wedgeGeom width b a) $ repeat white
        ,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
        ,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
        ]