module Dodge.Tesla.Arc (
    makeTeslaArc,
    updateTeslaArc,
) where

import Data.Foldable
import Data.Maybe
import Dodge.ArcStep
import Dodge.Damage
import Dodge.Data.ArcStep
import Dodge.Data.CrWlID
import Dodge.Data.World
import Dodge.Spark
import Geometry
import LensHelp
import MonadHelp
import Picture
import RandomHelp

aTeslaArcAt :: Color -> [ArcStep] -> TeslaArc
aTeslaArcAt col thearc =
    TeslaArc
        { _taPoints = map (^. asPos) thearc
        , _taArcSteps = thearc
        , _taTimer = 2
        , _taColor = brightX 100 1.5 col
        }

updateTeslaArc ::
    World ->
    TeslaArc ->
    (World, Maybe TeslaArc)
updateTeslaArc w pt
    | _taTimer pt == 2 = (makesparks $ foldl' (flip damthings) w thearc, Just $ pt & taTimer -~ 1)
    | _taTimer pt < 1 = (w, Nothing)
    | otherwise = (w, Just $ pt & taTimer -~ 1)
  where
    thearc = _taArcSteps pt
    rcol = brightX 100 1.5 <$> takeOne [white, azure, blue, cyan]
    rdir = state (randomR (-0.7, 0.7)) <&> (+ ld)
    rspeed = state (randomR (3, 6))
    makeaspark = randSpark ELECTRICAL rspeed rcol rdir lp
    makesparks = makeaspark . makeaspark . makeaspark
    (lp, ld) = case last thearc of
        ArcStep lp' ld' NothingID -> (lp', ld')
        ArcStep lp' ld' (CrID crid) -> case w ^? cWorld . lWorld . creatures . ix crid of
            Nothing -> (lp', ld')
            Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld', ld' + pi)
        ArcStep lp' ld' (WlID wlid) -> case w ^? cWorld . lWorld . walls . ix wlid of
            Nothing -> (lp', ld')
            Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld', ld' + pi)
    damthings (ArcStep p dir crwl) = damageCrWlID (thedamage p dir) crwl
    thedamage p dir = Damage ELECTRICAL 50 (p -.- q) p (p +.+ q) NoDamageEffect
      where
        q = 5 *.* unitVectorAtAngle dir

makeTeslaArc :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
makeTeslaArc ip pos dir w =
    ( w & randGen .~ g
        & cWorld . lWorld . teslaArcs .:~ aTeslaArcAt col newarc
    , ip & currentArc ?~ newarc
    )
  where
    (col, g) = takeOne [white, azure, blue, cyan] & runState $ _randGen w
    newarc = createArc ip w pos dir & evalState $ _randGen w

createArc ::
    ItemParams ->
    World ->
    Point2 ->
    Float ->
    State StdGen [ArcStep]
createArc arcparams@Arcing{_currentArc = Nothing} w p dir = createNewArc arcparams w p dir
createArc arcparams w p dir = updateArc arcparams w p dir

createNewArc ::
    ItemParams ->
    World ->
    Point2 ->
    Float ->
    State StdGen [ArcStep]
createNewArc arcparams w p dir =
    take (_arcNumber arcparams)
        <$> unfoldrMID (doStep (_newArcStep arcparams) arcparams w) (ArcStep p dir NothingID)

updateArc ::
    ItemParams ->
    World ->
    Point2 ->
    Float ->
    State StdGen [ArcStep]
updateArc ip w p dir = take (_arcNumber ip) <$> zipArcs ip w (ArcStep p dir NothingID) carc
  where
    carc = tail $ fromJust $ _currentArc ip

zipArcs ::
    ItemParams ->
    World ->
    ArcStep ->
    [ArcStep] ->
    State StdGen [ArcStep]
zipArcs ip w x (y : ys) =
    (x :) <$> do
        defaultnext <- doStep (_newArcStep ip) ip w x
        case defaultnext of
            Nothing -> return []
            Just z@(ArcStep _ _ (CrID _)) -> return [z]
            Just z@(ArcStep _ _ (WlID _)) -> return [z]
            Just z -> do
                p <- randInCirc 5
                let csize = _arcSize ip
                    center = _asPos x +.+ csize *.* unitVectorAtAngle (_asDir x)
                    newp = _asPos y +.+ p
                    --newdir = argV $ newp -.- _asPos x
                    newdir = _asDir x
                if dist newp center < csize
                    then zipArcs ip w (y & asPos .~ newp & asDir .~ newdir) ys
                    else zipArcs ip w z ys
zipArcs ip w y _ = createNewArc ip w (_asPos y) (_asDir y)