|
|
|
@@ -1,169 +0,0 @@
|
|
|
|
|
module Dodge.Tesla.Arc (
|
|
|
|
|
makeTeslaArc,
|
|
|
|
|
updateTeslaArc,
|
|
|
|
|
) where
|
|
|
|
|
|
|
|
|
|
import Data.Foldable
|
|
|
|
|
import Data.List (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
|
|
|
|
|
|
|
|
|
|
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]
|
|
|
|
|
rspeed = state (randomR (3, 6))
|
|
|
|
|
makeaspark = randSpark ELECTRICAL rspeed rcol rdir lp
|
|
|
|
|
makesparks = makeaspark . makeaspark . makeaspark
|
|
|
|
|
rp x = randPeakedParam 2 (x - 0.7) x (x + 0.7)
|
|
|
|
|
(lp, rdir) = case last thearc of
|
|
|
|
|
ArcStep lp' ld' NothingID -> (lp', rp ld')
|
|
|
|
|
ArcStep lp' ld' (CrID crid) -> case w ^? cWorld . lWorld . creatures . ix crid of
|
|
|
|
|
Nothing -> (lp', rp ld')
|
|
|
|
|
Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld', rp $ ld' + pi)
|
|
|
|
|
ArcStep lp' ld' (WlID wlid) -> case w ^? cWorld . lWorld . walls . ix wlid of
|
|
|
|
|
Nothing -> (lp', rp ld')
|
|
|
|
|
Just wl ->
|
|
|
|
|
( lp' -.- 2 *.* unitVectorAtAngle ld'
|
|
|
|
|
, randWallReflect ld' wl
|
|
|
|
|
)
|
|
|
|
|
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
|
|
|
|
|
|
|
|
|
|
randWallReflect :: RandomGen g => Float -> Wall -> State g Float
|
|
|
|
|
randWallReflect a wl = do
|
|
|
|
|
let (x, y) = _wlLine wl
|
|
|
|
|
outa = reflectAngle a x y
|
|
|
|
|
a1 = nearestAngleRep outa $ argV (x - y)
|
|
|
|
|
a2 = if a1 < outa then a1 + pi else a1 - pi
|
|
|
|
|
randPeaked a1 outa a2
|
|
|
|
|
|
|
|
|
|
makeTeslaArc :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
|
|
|
|
|
makeTeslaArc ip pos dir w =
|
|
|
|
|
( w & randGen .~ g
|
|
|
|
|
& cWorld . lWorld . teslaArcs
|
|
|
|
|
.:~ TeslaArc
|
|
|
|
|
{ _taPoints = map (^. asPos) newarc
|
|
|
|
|
, _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 = 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 (doArcStep (_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 <- doArcStep (_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)
|
|
|
|
|
|
|
|
|
|
doArcStep :: NextArcStep -> ItemParams -> World -> ArcStep -> State StdGen (Maybe ArcStep)
|
|
|
|
|
doArcStep nas = case nas of
|
|
|
|
|
DefaultArcStep -> defaultArcStep
|
|
|
|
|
EndArc -> const $ const $ const $ return Nothing
|
|
|
|
|
|
|
|
|
|
defaultArcStep ::
|
|
|
|
|
RandomGen g =>
|
|
|
|
|
ItemParams ->
|
|
|
|
|
World ->
|
|
|
|
|
ArcStep ->
|
|
|
|
|
State g (Maybe ArcStep)
|
|
|
|
|
defaultArcStep _ _ (ArcStep _ _ (CrID _)) = return Nothing
|
|
|
|
|
defaultArcStep _ _ (ArcStep _ _ (WlID _)) = return Nothing
|
|
|
|
|
defaultArcStep itparams w (ArcStep p dir _) = do
|
|
|
|
|
let csize = _arcSize itparams
|
|
|
|
|
--rot <- takeOne [pi/4,negate pi/4]
|
|
|
|
|
rot <- takeOne [0]
|
|
|
|
|
let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
|
|
|
|
|
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)
|
|
|
|
|
-- collidePointWallsWall and wlsnearpoint
|
|
|
|
|
$ 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]
|
