loop/src/Dodge/Tesla.hs

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

import Control.Applicative
import Control.Monad
--import Control.Applicative
--import Data.Foldable
--import Data.List (uncons) --(sortOn)
import Data.Maybe
--import Dodge.Base.Collide
--import Dodge.Damage
import Dodge.Data.ArcStep
import Dodge.Data.CrWlID
import Dodge.Data.World
import Dodge.Movement.Turn
import Dodge.WorldEvent.ThingsHit
--import Dodge.Spark
import Geometry
--import qualified IntMapHelp as IM
import LensHelp
--import MonadHelp
import Picture
import RandomHelp

--import Shape

makeTeslaArc :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
makeTeslaArc ip pos dir w =
    ( w & randGen .~ g
        & cWorld . lWorld . teslaArcs
            .:~ TeslaArc
                { _taArcSteps = newarc
                , _taTimer = 2
                , _taColor = brightX 100 1.5 col
                }
    , ip & currentArc .~ newarc
    )
  where
    (col, g) = takeOne [white, azure, blue, cyan] & runState $ _randGen w
    newarc = updateArc ip w pos dir & evalState $ _randGen w

updateArc :: ItemParams -> World -> Point2 -> Float -> State StdGen [ArcStep]
updateArc ip w p dir = take 10 <$> zipArcs endarc w (ArcStep p dir NothingID) carc
  where
    endarc = snd <$> unsnoc (_currentArc ip)
    carc = case _currentArc ip of
        (_ : xs) -> xs
        [] -> []

zipArcs :: Maybe ArcStep -> World -> ArcStep -> [ArcStep] -> State StdGen [ArcStep]
zipArcs d w x ys =
    (x :) <$> do
        let mys = uncons ys
        na <- nextArc d w x (fmap fst mys)
        case na of
            Just a -> zipArcs d w a (join $ maybeToList (fmap snd mys))
            Nothing -> return []

nextArc ::
    Maybe ArcStep ->
    World ->
    ArcStep ->
    Maybe ArcStep ->
    State StdGen (Maybe ArcStep)
nextArc endarc w lastarc mx
    | ArcStep p d NothingID <- lastarc = do
        offset <- randInCirc 20
        let pdir = 20 * unitVectorAtAngle d
            (dout, pout) = fromMaybe (d, pdir) $ do
                p' <- endArcPos endarc <|> mx ^? _Just . asPos
                let tangle = 0.5
                    d' = turnTo tangle p p' d
                return (d', vecTurnTo tangle p p' pdir)
            newp = fromMaybe (p + pout + offset) $ do
                p' <- endArcPos endarc
                guard $ dist p' p < 20
                return p'
        return $ case thingHit p newp w of
            Nothing -> Just $ ArcStep newp dout NothingID
            Just (p', Left cr) -> Just $ ArcStep p' dout (CrID (_crID cr))
            Just (p', Right wl) -> Just $ ArcStep p' dout (WlID (_wlID wl))
    | otherwise = return Nothing

-- might want to check whether any cr/wall exists
endArcPos :: Maybe ArcStep -> Maybe Point2
endArcPos mas = do
    as <- mas
    case as ^. asObject of
        NothingID -> Nothing
        CrID {} -> do
            as ^? asPos
        WlID {} -> do
            as ^? asPos

--nextArc :: Float -> World -> ArcStep -> Maybe ArcStep -> State StdGen (Maybe ArcStep)
--nextArc d w lastarc mx
--    | ArcStep p d NothingID <- lastarc = do
--        newp' <- ((p + (20 *.* unitVectorAtAngle d)) +) <$> randInCirc 10
--        x <- state $ randomR (0,1::Float)
--        let newp = fromMaybe newp' $ do
--                p' <- mx ^? _Just . asPos
--                thit <- mx ^? _Just . asObject
--                return $ if x > 0.3 || thit /= NothingID then alongSegBy 20 p p' else newp'
--        return $ case thingHit p newp w of
--            Nothing -> Just $ ArcStep newp d NothingID
--            Just (p', Left cr) -> Just $ ArcStep p' d (CrID (_crID cr))
--            Just (p', Right wl) -> Just $ ArcStep p' d (WlID (_wlID wl))
--    | otherwise = return Nothing

--zipArcs' :: World -> ArcStep -> [ArcStep] -> State StdGen [ArcStep]
--zipArcs' w x (y : ys) =
--    (x :) <$> do
--        defaultnext <- defaultArcStep 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 = 20
--                    center = _asPos x +.+ csize *.* unitVectorAtAngle (_asDir x)
--                    newp = _asPos y +.+ p
--                    newdir = _asDir x
--                if dist newp center < csize
--                    then zipArcs w (y & asPos .~ newp & asDir .~ newdir) ys
--                    else zipArcs w z ys
--zipArcs' w y _ = createNewArc w (_asPos y) (_asDir y)

--createNewArc :: World -> Point2 -> Float -> State StdGen [ArcStep]
--createNewArc w p dir = take 10 <$> unfoldrMID (defaultArcStep w) (ArcStep p dir NothingID)
--
--defaultArcStep :: RandomGen g => World -> ArcStep -> State g (Maybe ArcStep)
--defaultArcStep w (ArcStep p dir NothingID) = do
--    newp <- (center +.+) <$> randInCirc csize
--    let mcr =
--            listToMaybe
--                . sortOn (dist center . _crPos)
--                . filter (\cr -> dist center (_crPos cr) < csize)
--                . IM.elems
--                $ w ^. cWorld . lWorld . creatures --_creatures (_cWorld w)
--        mwl =
--            listToMaybe
--                . sortOn (dist p . fst)
--                . mapMaybe (\q -> sequence $ collidePointWallsFilter (const True) p (center +.+ q) w)
--                $ polyCirc 6 csize
--        f (q, wl) = ArcStep q dir (WlID $ _wlID wl)
--        g cr = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (CrID $ _crID cr)
--    --return . listToMaybe . sortOn (dist p . (^. asPos)) $
--    --    ArcStep newp dir NothingID : catMaybes [fmap f mwl, fmap g mcr]
--    return $ fmap g mcr <|> (listToMaybe . sortOn (dist p . (^. asPos)) $
--        ArcStep newp dir NothingID : catMaybes [fmap f mwl])
--  where
--    csize = 20
--    center = (20 *.* unitVectorAtAngle dir) +.+ p
--defaultArcStep _ _ = return Nothing