134 lines
5.2 KiB
Haskell
134 lines
5.2 KiB
Haskell
module Dodge.Tesla (
|
|
makeTeslaArc,
|
|
-- updateTeslaArc,
|
|
) where
|
|
|
|
import Dodge.Movement.Turn
|
|
import Control.Monad
|
|
import Dodge.WorldEvent.ThingsHit
|
|
--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.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 dir w (ArcStep p dir NothingID) carc
|
|
where
|
|
carc = case _currentArc ip of
|
|
(_ : xs) -> xs
|
|
[] -> []
|
|
|
|
zipArcs :: Float -> 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 :: Float -> World -> ArcStep -> Maybe ArcStep -> State StdGen (Maybe ArcStep)
|
|
nextArc _ w lastarc mx
|
|
| ArcStep p d NothingID <- lastarc = do
|
|
offset <- randInCirc 5
|
|
let pdir = 20 * unitVectorAtAngle d
|
|
(dout,pout) = fromMaybe (d,pdir) $ do
|
|
p' <- mx ^? _Just . asPos
|
|
let d' = turnTo 0.5 p p' d
|
|
return $ (d', vecTurnTo 0.5 p p' pdir)
|
|
newp = p + pout + offset
|
|
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
|
|
|
|
--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
|