Cleanup and reorganise

This commit is contained in:
2021-10-31 19:46:32 +00:00
parent 41e64d14c3
commit 08fa84c1fd
53 changed files with 1352 additions and 1407 deletions
+31 -42
View File
@@ -2,11 +2,12 @@
Creation of particles in the world.
-}
module Dodge.WorldEvent.SpawnParticle
( createSparkCol
, makeGasCloud
( makeGasCloud
, aFlameParticle
, makeFlameletTimed
, makeTeslaArcAt
, colSpark
, colSpark'
) where
import Dodge.Data
import Dodge.Data.DamageType
@@ -260,15 +261,12 @@ makeTeslaArcAt col pos dir = LinearParticle
, _ptColor = brightX 100 1.5 col
}
drawTeslaArc :: Particle -> Picture
drawTeslaArc pt = pic
drawTeslaArc pt = setLayer 1 $ pictures
[ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ lineOfThickness 3 ps
, setDepth 20 $ color (V4 0 0 0 0.5) $ lineOfThickness 10 ps
]
where
ps' = _ptPoints pt
pic = setLayer 1 $ pictures
[ setDepth 20.5 $ color (brightX 2 2 $ _ptColor pt) $ lineOfThickness 3 ps'
-- , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps'
-- , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps'
-- , setDepth 20 $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps'
]
ps = _ptPoints pt
-- todo: fix electrical damage location
moveTeslaArc
:: Point2 -- ^ Emmission position
@@ -279,7 +277,7 @@ moveTeslaArc
moveTeslaArc p d w pt
| t == 2 =
(foldr damCrs w hitCrs & randGen .~ g
& createSparkCol 8 nc q2 (argV sv + d1)
& colSpark 8 nc q2 (argV sv)
, Just $ pt
& ptTimer -~ 1
& ptPoints .~ ps'
@@ -305,39 +303,28 @@ moveTeslaArc p d w pt
q1 = last $ init ps'
q2 = last ps'
hitWall = reflectPointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
(d1,_) = randomR (-0.7,0.7) $ _randGen w
sv = maybe (q2 -.- q1) snd hitWall
{-
Finds a point somewhere roughly inbetween two points.
-}
{- 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.
-}
{- 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.
-}
{- 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 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) = (0, _randGen w)
where (dChange, g) = randomR (-0.5,0.5) $ _randGen w
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'.
@@ -349,8 +336,7 @@ crOrWallSensitive
-> Float -- ^ Wall attraction parameter
-> World
-> Either3 Creature Point2 Point2
crOrWallSensitive p dir wlAttract w =
fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
. listToMaybe
. sortBy (compare `on` g)
$ catMaybes [cr,wlp]
@@ -374,12 +360,16 @@ crOrWallSensitive p dir wlAttract w =
g _ = 0
(arcLen,_) = randomR (25,50) $ _randGen w
-- BUG: can hit crs through walls
-- | Create a spark.
-- If the spark is created by another Particle, it cannot be directly added to
-- the list, hence the redirect through worldEvents.
createSparkCol :: Int -> Color -> Point2 -> Float -> World -> World
createSparkCol time col pos dir = worldEvents %~ ( over particles (spark :) . )
colSpark :: Int -> Color -> Point2 -> Float -> World -> World
colSpark = colSpark' 0.7
colSpark' :: Float -> Int -> Color -> Point2 -> Float -> World -> World
colSpark' randDir time col pos baseDir w = w
& worldEvents %~ ( over particles (spark :) . )
& randGen .~ g
where
(a,g) = randomR (-randDir,randDir) $ _randGen w
dir = a + baseDir
spark = BulletPt
{ _ptDraw = drawBul
, _ptUpdate = mvGenBullet
@@ -391,8 +381,7 @@ createSparkCol time col pos dir = worldEvents %~ ( over particles (spark :) . )
, _btTimer' = time
, _btHitEffect' = destroyOnImpact sparkEff noEff
}
sparkEff bt p cr
= creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
where
sp = head (_btTrail' bt)
ep = sp +.+ _btVel' bt