Cleanup tesla arcs
This commit is contained in:
@@ -109,7 +109,7 @@ bulletDestroySpawn :: (Point2 -> State StdGen Particle)
|
||||
-> (World, Maybe Particle)
|
||||
bulletDestroySpawn f = destroyOnImpact (bulDestroyCr f) (bulDestroyWall f)
|
||||
|
||||
{- | Create a flamelet when hitting a creature. -}
|
||||
{- | Create a particle when hitting a creature. -}
|
||||
bulDestroyCr :: (Point2 -> State StdGen Particle)
|
||||
-> Particle -> Point2 -> Creature -> World -> World
|
||||
bulDestroyCr f bt p cr w = w
|
||||
|
||||
+37
-15
@@ -2,19 +2,22 @@ module Dodge.Particle.Spark
|
||||
( colSpark
|
||||
, colSparkRandDir
|
||||
, createBarrelSpark
|
||||
, randColDirTimeSpark
|
||||
)
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Particle.Bullet.Draw
|
||||
import Dodge.Particle.Bullet.Update
|
||||
import Dodge.WorldEvent.HitEffect
|
||||
import Dodge.Particle.Bullet.DestroyDamage
|
||||
--import Dodge.WorldEvent.HitEffect
|
||||
import Color
|
||||
import Geometry
|
||||
import LensHelp
|
||||
|
||||
import Control.Monad.State
|
||||
import System.Random
|
||||
--import Control.Lens
|
||||
|
||||
-- TODO remove/simplify this function
|
||||
createBarrelSpark :: Point2 -> Float -> Maybe Int -> Int -> Int -> World -> World
|
||||
createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt
|
||||
{ _ptDraw = drawBul
|
||||
@@ -26,16 +29,40 @@ createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt
|
||||
, _ptCrIgnore = maycid
|
||||
, _ptWidth = 1
|
||||
, _ptTimer = time
|
||||
, _ptHitEff = destroyOnImpact sparkEff noEff
|
||||
, _ptHitEff = bulletDestroyDamage SparkDam 1
|
||||
}
|
||||
where
|
||||
sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage
|
||||
.:~ Damage SparkDam 1 sp p ep NoDamageEffect
|
||||
where
|
||||
sp = head (_ptTrail bt)
|
||||
ep = sp +.+ _ptVel bt
|
||||
colSpark :: Int -> Color -> Point2 -> Float -> World -> World
|
||||
colSpark = colSparkRandDir 0.7
|
||||
|
||||
randColDirTimeSpark
|
||||
:: State StdGen Color
|
||||
-> State StdGen Float
|
||||
-> State StdGen Int
|
||||
-> Point2
|
||||
-> World
|
||||
-> World
|
||||
randColDirTimeSpark randcol randdir randtime pos w = w
|
||||
& instantParticles .:~ spark
|
||||
& randGen .~ g
|
||||
where
|
||||
((col,dir,time),g) = (`runState` _randGen w) $ do
|
||||
c <- randcol
|
||||
d <- randdir
|
||||
t <- randtime
|
||||
return (c,d,t)
|
||||
spark = BulletPt
|
||||
{ _ptDraw = drawBul
|
||||
, _ptUpdate = mvBullet
|
||||
, _btDrag = 0.9
|
||||
, _ptVel = rotateV dir (V2 5 0)
|
||||
, _ptColor = col
|
||||
, _ptTrail = [pos]
|
||||
, _ptCrIgnore = Nothing
|
||||
, _ptWidth = 1
|
||||
, _ptTimer = time
|
||||
, _ptHitEff = bulletDestroyDamage SparkDam 1
|
||||
}
|
||||
|
||||
colSparkRandDir :: Float -> Int -> Color -> Point2 -> Float -> World -> World
|
||||
colSparkRandDir randDir time col pos baseDir w = w
|
||||
& instantParticles .:~ spark
|
||||
@@ -53,10 +80,5 @@ colSparkRandDir randDir time col pos baseDir w = w
|
||||
, _ptCrIgnore = Nothing
|
||||
, _ptWidth = 1
|
||||
, _ptTimer = time
|
||||
, _ptHitEff = destroyOnImpact sparkEff noEff
|
||||
, _ptHitEff = bulletDestroyDamage SparkDam 1
|
||||
}
|
||||
sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage
|
||||
.:~ Damage SparkDam 1 sp p ep NoDamageEffect
|
||||
where
|
||||
sp = head (_ptTrail bt)
|
||||
ep = sp +.+ _ptVel bt
|
||||
|
||||
+25
-121
@@ -1,45 +1,35 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Particle.TeslaArc
|
||||
( aTeslaArcAt
|
||||
, aTeslaArcAt'
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Damage
|
||||
import Dodge.WorldEvent.Damage
|
||||
import Dodge.Base
|
||||
import Dodge.Zone
|
||||
import Dodge.Base.Collide
|
||||
--import Dodge.WorldEvent.Damage
|
||||
--import Dodge.Base
|
||||
--import Dodge.Zone
|
||||
--import Dodge.Base.Collide
|
||||
import Dodge.Particle.Spark
|
||||
import Dodge.WorldEvent.ThingsHit
|
||||
--import Dodge.WorldEvent.ThingsHit
|
||||
import Dodge.RandomHelp
|
||||
import Picture
|
||||
import Geometry
|
||||
import qualified IntMapHelp as IM
|
||||
--import qualified IntMapHelp as IM
|
||||
import LensHelp
|
||||
|
||||
import System.Random
|
||||
import Control.Monad.State
|
||||
import Data.Function (on)
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
--import Data.Function (on)
|
||||
--import Data.List
|
||||
--import Data.Maybe
|
||||
|
||||
aTeslaArcAt' :: Color -> [(Point2,Float,Maybe (Either Creature Wall))] -> Particle
|
||||
aTeslaArcAt' col thearc = LinearParticle
|
||||
aTeslaArcAt :: Color -> [(Point2,Float,Maybe (Either Creature Wall))] -> Particle
|
||||
aTeslaArcAt col thearc = LinearParticle
|
||||
{ _ptPoints = map (^. _1) thearc
|
||||
, _ptDraw = drawTeslaArc
|
||||
, _ptUpdate = moveTeslaArc' thearc
|
||||
, _ptUpdate = moveTeslaArc thearc
|
||||
, _ptTimer = 2
|
||||
, _ptColor = brightX 100 1.5 col
|
||||
}
|
||||
|
||||
aTeslaArcAt :: Color -> Point2 -> Float -> Particle
|
||||
aTeslaArcAt col pos dir = LinearParticle
|
||||
{ _ptPoints = [pos]
|
||||
, _ptDraw = drawTeslaArc
|
||||
, _ptUpdate = moveTeslaArc pos dir
|
||||
, _ptTimer = 2
|
||||
, _ptColor = brightX 100 1.5 col
|
||||
}
|
||||
drawTeslaArc :: Particle -> Picture
|
||||
drawTeslaArc pt = setLayer 1 $ pictures
|
||||
[ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ thickLine 3 ps
|
||||
@@ -47,112 +37,26 @@ drawTeslaArc pt = setLayer 1 $ pictures
|
||||
]
|
||||
where
|
||||
ps = _ptPoints pt
|
||||
moveTeslaArc' :: [(Point2,Float,Maybe (Either Creature Wall))]
|
||||
moveTeslaArc :: [(Point2,Float,Maybe (Either Creature Wall))]
|
||||
-> World
|
||||
-> Particle
|
||||
-> (World,Maybe Particle)
|
||||
moveTeslaArc' thearc w pt
|
||||
| _ptTimer pt == 2 = (foldr damthings w thearc, Just $ pt & ptTimer -~ 1)
|
||||
moveTeslaArc thearc w pt
|
||||
| _ptTimer pt == 2 = (makesparks $ foldr damthings w thearc, Just $ pt & ptTimer -~ 1)
|
||||
| _ptTimer pt < 1 = (w, Nothing)
|
||||
| otherwise = (w, Just $ pt & ptTimer -~ 1)
|
||||
where
|
||||
rcol = brightX 100 1.5 <$> takeOne [white,azure,blue,cyan]
|
||||
rdir = state (randomR (-0.7,0.7)) <&> (+ ld)
|
||||
rtime = state $ randomR (5,8)
|
||||
makeaspark = randColDirTimeSpark rcol rdir rtime lp
|
||||
makesparks = makeaspark . makeaspark . makeaspark
|
||||
(lp,ld) = case last thearc of
|
||||
(lp',ld',Nothing) -> (lp',ld')
|
||||
(lp',ld',Just (Left cr)) -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi)
|
||||
(lp',ld',Just (Right _)) -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi)
|
||||
damthings (_,_,Nothing) = id
|
||||
damthings (p,dir,Just crwl) = damageCrWall (thedamage p dir) crwl
|
||||
thedamage p dir = Damage Electrical 5 (p -.- q) p (p +.+ q) NoDamageEffect
|
||||
thedamage p dir = Damage Electrical 50 (p -.- q) p (p +.+ q) NoDamageEffect
|
||||
where
|
||||
q = 5 *.* unitVectorAtAngle dir
|
||||
-- todo: fix electrical damage location
|
||||
moveTeslaArc
|
||||
:: Point2 -- ^ Emmission position
|
||||
-> Float -- ^ Emmission direction
|
||||
-> World
|
||||
-> Particle
|
||||
-> (World, Maybe Particle)
|
||||
moveTeslaArc p d w pt
|
||||
| t == 2 =
|
||||
( foldr damCrs w hitCrs
|
||||
& randGen .~ g
|
||||
& colSpark 8 nc q2 (argV sv)
|
||||
& damThingHitWith (\p1 p2 p3 -> Damage Electrical 50 p1 p2 p3 NoDamageEffect)
|
||||
q1 ((2 *.* q2) -.- q1) thHit
|
||||
, Just $ pt & ptTimer -~ 1 & ptPoints .~ ps'
|
||||
)
|
||||
| t < 1 = (w , Nothing)
|
||||
| otherwise = (w , Just $ pt & ptTimer -~ 1)
|
||||
where
|
||||
t = _ptTimer pt
|
||||
ps = take 5 $ p : map f (crsLightChain p d 0 w)
|
||||
f (E3x1 cr) = _crPos cr
|
||||
f (E3x2 (p1,_)) = p1
|
||||
f (E3x3 p1) = p1
|
||||
ps' = lightningMids d pers ps
|
||||
pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w
|
||||
nc = brightX 100 1.5 $ numColor colid
|
||||
(colid,g) = randomR (0::Int,5) $ _randGen w
|
||||
f1 (E3x1 cr) = Just $ _crID cr
|
||||
f1 _ = Nothing
|
||||
hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
|
||||
damCrs cid = creatures . ix cid . crState . crDamage
|
||||
.:~ Damage Electrical 5 cpos cpos cpos NoDamageEffect
|
||||
where
|
||||
cpos = _crPos (_creatures w IM.! cid)
|
||||
q1 = last $ init ps'
|
||||
q2 = last ps'
|
||||
hitWall = reflectPointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
|
||||
thHit = thingHit q1 ((2 *.* q2) -.- q1) w
|
||||
sv = maybe (q2 -.- q1) snd hitWall
|
||||
{- Finds a point somewhere roughly inbetween two points. -}
|
||||
lightningMid :: Float -> Point2 -> Point2 -> Point2
|
||||
lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3
|
||||
where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2
|
||||
{- Finds extra middle points between successive points in a list of points. -}
|
||||
lightningMids :: Float -> [Point2] -> [Point2] -> [Point2]
|
||||
lightningMids d1 (p:pers) (p1:p3:ps)
|
||||
= let p2 = p +.+ lightningMid d1 p1 p3
|
||||
d2 = argV $ p3 -.- p2
|
||||
in p1 : p2 : lightningMids d2 pers (p3:ps)
|
||||
lightningMids _ _ ps = ps
|
||||
{- Finds a list of hit things from a given point.
|
||||
'E3x1' objects are creatures, 'E3x2' objects are points on walls, 'E3x3' objects are points in space. -}
|
||||
crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature (Point2,Wall) Point2]
|
||||
crsLightChain p d wlAttract w = case crOrWallSensitive p d wlAttract w of
|
||||
E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p))
|
||||
(min 1 (wlAttract + 0.3)) w
|
||||
E3x2 p1 -> [E3x2 p1]
|
||||
E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w)
|
||||
where
|
||||
(dChange, g) = randomR (-0.5,0.5) $ _randGen w
|
||||
{-
|
||||
Finds whether a creature or wall is in front of a given point and direction.
|
||||
Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'.
|
||||
Has a parameter to tweak how attracted the test is to walls.
|
||||
-}
|
||||
crOrWallSensitive
|
||||
:: Point2 -- ^ Start point
|
||||
-> Float -- ^ Direction (radians)
|
||||
-> Float -- ^ Wall attraction parameter
|
||||
-> World
|
||||
-> Either3 Creature (Point2,Wall) Point2
|
||||
crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
|
||||
. listToMaybe
|
||||
. sortBy (compare `on` g)
|
||||
$ catMaybes [cr,wlp]
|
||||
where
|
||||
cr = E3x1 <$> nearestCrInFront p dir 100 w
|
||||
wlp = fmap E3x2
|
||||
. listToMaybe
|
||||
. sortBy (compare `on` dist p . fst)
|
||||
$ mapMaybe
|
||||
( (\p1 -> collidePointWallsWall p p1 $ wallsNearPoint p w)
|
||||
. (+.+) p
|
||||
. (\d -> rotateV d (V2 100 0))
|
||||
. (+ dir)
|
||||
. (* wlAttract)
|
||||
)
|
||||
[-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
|
||||
g (E3x2 (p1,_)) = 100 + dist p p1 -- tweak makes it more likely to hit crs first
|
||||
--g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first
|
||||
g (E3x1 cr1) = dist p $ _crPos cr1
|
||||
g _ = 0
|
||||
(arcLen,_) = randomR (25,50) $ _randGen w
|
||||
-- BUG: can hit crs through walls
|
||||
|
||||
Reference in New Issue
Block a user