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