justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Move sparks into dedicated datatype

Browse Source
This commit is contained in:
justin
2022-07-18 12:15:05 +01:00
parent 13f2255ba7
commit 5495d33389
16 changed files with 99 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Damage.hs
+1 -1
View File
@@ -59,7 +59,7 @@ applyIndividualDamage' cr w dm = case _dmType dm of
applyPiercingDamage :: Creature -> Damage -> World -> World
applyPiercingDamage cr dm
| crIsArmouredFrom p cr = colSpark 8 (brightX 10 1.5 orange) p1 (argV (p1 -.- p))
| crIsArmouredFrom p cr = colSpark (brightX 10 1.5 orange) p1 (argV (p1 -.- p))
| otherwise = damageHP cr $ _dmAmount dm
where
p = _dmAt dm
src/Dodge/Creature/Inanimate.hs
+2 -3
View File
@@ -70,11 +70,10 @@ updateExpBarrel cr w
damages = _csDamage $ _crState cr
pierceSparks :: [World -> World]
pierceSparks
= zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p))
poss as times colids
= zipWith3 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p))
poss as colids
as = randomRs (-0.7,0.7) g
colids = randomRs (0,11) g
times = randomRs (2,5) g
poss = _piercedPoints $ _csSpState $ _crState cr
newCr = Just $ applyFuseDamage $ set (crState . csDamage) [] $ damToExpBarrel damages cr
applyFuseDamage cr' = cr' & crHP %~
src/Dodge/Data.hs
+3 -10
View File
@@ -10,6 +10,7 @@ circular imports are probably not a good idea.
{-# LANGUAGE DerivingStrategies #-}
module Dodge.Data
( module Dodge.Data
, module Dodge.Data.Spark
, module Dodge.Data.Bullet
, module Dodge.Data.Door
, module Dodge.Data.Item
@@ -47,6 +48,7 @@ module Dodge.Data
, module Dodge.Data.RadarBlip
, module Dodge.Data.PathGraph
) where
import Dodge.Data.Spark
import Dodge.Data.Bullet
import Dodge.Data.Door
import Dodge.Data.Item
@@ -147,6 +149,7 @@ data World = World
, _bullets :: [Bullet]
, _instantParticles :: [Particle]
, _particles :: [Particle]
, _sparks :: [Spark]
, _radarBlips :: [RadarBlip]
, _flares :: [Flare]
, _newBeams :: WorldBeams
@@ -544,16 +547,6 @@ data Particle
, _ptPhaseV :: Float
, _ptPoints :: [Point2]
}
| PtSpark
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptVel :: Point2
, _ptDrag :: Float
, _ptColor :: Color
, _ptTrail :: [Point2]
, _ptWidth :: Float
, _ptTimer :: Int
, _ptHitEff :: HitEffect
}
| PtTeslaArc
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptPoints :: [Point2]
src/Dodge/Data/Spark.hs
+14
View File
@@ -0,0 +1,14 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Spark where
import Geometry.Data
import Color
import Control.Lens
data Spark = Spark
{ _skVel :: Point2
, _skColor :: Color
, _skPos :: Point2
, _skOldPos :: Point2
, _skWidth :: Float
}
makeLenses ''Spark
src/Dodge/Default/World.hs
+1
View File
@@ -43,6 +43,7 @@ defaultWorld = World
, _bullets = []
, _instantParticles = []
, _particles = []
, _sparks = []
, _radarBlips = []
, _flares = []
, _newBeams = WorldBeams [] [] [] []
src/Dodge/Material/Damage.hs
+2 -2
View File
@@ -16,8 +16,8 @@ defDamageMaterial dm _ w = (_dmAmount dm, w)
damageStone :: Damage -> Float -> World -> (Int,World)
damageStone dm dir = case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (argV $ reflectIn (p -.- sp) v)
PIERCING -> a d $ colSparkRandDir 0.2 8 pSparkCol outTo (argV $ reflectIn (p -.- sp) v)
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (argV $ reflectIn (p -.- sp) v)
PIERCING -> a d $ colSparkRandDir 0.2 pSparkCol outTo (argV $ reflectIn (p -.- sp) v)
BLUNT -> a d id
SHATTERING -> a d id
CRUSHING -> a d id
src/Dodge/Particle/Damage.hs
-8
View File
@@ -15,14 +15,6 @@ simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
bulVel = _buVel bt
ep = sp +.+ bulVel
basicSparkDams :: Particle -> Point2 -> [Damage]
basicSparkDams bt p = [ Damage SPARKING 1 sp p ep NoDamageEffect ]
where
sp = head $ _ptTrail bt
bulVel = _ptVel bt
ep = sp +.+ bulVel
hvBulDams :: [Damage]
hvBulDams =
[ Damage PIERCING 25 0 0 0 NoDamageEffect
src/Dodge/Particle/Draw.hs
-7
View File
@@ -10,7 +10,6 @@ drawParticle pt = case pt of
PtStaticBall {} -> drawStaticBall pt
PtIncBall {} -> drawFlameletZ pt
PtInvShockwave {} -> drawInverseShockwave pt
PtSpark {} -> drawSpark pt
PtTeslaArc {} -> drawTeslaArc pt
PtTargetLaser {} -> drawTargetLaser pt
LaserParticle {} -> drawLaser pt
@@ -124,12 +123,6 @@ drawInverseShockwave pt
rad = r - 0.1 * r * fromIntegral (10 - t)
thickness = fromIntegral (10 - t) **2 * rad / 40
drawSpark :: Particle -> Picture
drawSpark pt = setLayer BloomNoZWrite
. setDepth 20
. color (_ptColor pt)
$ thickLine (_ptWidth pt) (take 2 $ _ptTrail pt)
drawTeslaArc :: Particle -> Picture
drawTeslaArc pt = setLayer BloomNoZWrite $ pictures
[ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ thickLine 3 ps
src/Dodge/Particle/HitEffect/ExpireAndDamage.hs
+1 -2
View File
@@ -15,8 +15,7 @@ expireAndDamage :: (Particle -> Point2 -> [Damage])
-> (World, Maybe Particle)
expireAndDamage fdm bt things w = case runIdentity $ S.head_ things of
Nothing -> (w, mvPt' bt)
Just x -> (doDamages fdm x bt w, destroyAt (fst x) bt)
Just x -> (doDamages fdm x bt w, destroyAt bt)
doDamages :: (Particle -> Point2 -> [Damage])
-> (Point2, Either Creature Wall)
src/Dodge/Particle/TeslaArc.hs
+1 -2
View File
@@ -28,8 +28,7 @@ moveTeslaArc thearc w pt
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
makeaspark = randColDirTimeSpark rcol rdir lp
makesparks = makeaspark . makeaspark . makeaspark
(lp,ld) = case last thearc of
ArcStep lp' ld' Nothing -> (lp',ld')
src/Dodge/Particle/Update.hs
+2 -8
View File
@@ -1,19 +1,14 @@
module Dodge.Particle.Update where
import Dodge.Data
import LensHelp
import Geometry
mvPt' :: Particle -> Maybe Particle
mvPt' pt = Just $ pt
& ptTrail %~ f
& ptTimer -~ 1
where
f trl = head trl +.+ _ptVel pt : trl
destroyAt :: Point2 -> Particle -> Maybe Particle
destroyAt hitp pt = Just $ pt
destroyAt :: Particle -> Maybe Particle
destroyAt pt = Just $ pt
& ptUpdate .~ killParticleUpdate
& ptTrail .:~ hitp
& ptTimer %~ (min 3 . subtract 1)
killParticleUpdate :: World -> Particle -> (World,Maybe Particle)
@@ -21,5 +16,4 @@ killParticleUpdate w pt
| _ptTimer pt <= 0 = (w,Nothing)
| otherwise = (w
, Just $ pt & ptTimer -~ 1
& ptTrail %~ (\(x:xs) -> x:x:xs)
)
src/Dodge/Render/ShapePicture.hs
+2
View File
@@ -6,6 +6,7 @@ import Dodge.Creature.Picture.Awareness
import Dodge.Creature.Picture
import Dodge.Particle.Draw
import Dodge.Bullet.Draw
import Dodge.Spark.Draw
import Dodge.RadarBlip
import Dodge.Flare
import Dodge.ShortShow
@@ -85,6 +86,7 @@ cullPoint cfig w p
extraPics :: Configuration -> World -> Picture
extraPics cfig w = pictures (_decorations w)
<> concatMapPic drawParticle (_particles w)
<> concatMapPic drawSpark (_sparks w)
<> concatMapPic drawBul (_bullets w)
<> concatMapPic drawBlip (_radarBlips w)
<> concatMapPic drawFlare (_flares w)
src/Dodge/Spark.hs
+48 -55
View File
@@ -1,5 +1,5 @@
module Dodge.Spark
( mvSpark
( moveSpark
, colSpark
, colSparkRandDir
, createBarrelSpark
@@ -9,86 +9,79 @@ import Dodge.Data
import Dodge.WorldEvent.ThingsHit
import Geometry
import LensHelp
import Dodge.Particle.HitEffect.ExpireAndDamage
import Dodge.Particle.Damage
import Color
import Control.Monad.State
import System.Random
import Data.Bifunctor
mvSpark :: World -> Particle -> (World, Maybe Particle)
mvSpark w bt'
| t <= 0 || magV (_ptVel bt) < 1 = (w,Nothing)
| otherwise = second (fmap dodrag) $
hiteff bt (thingsHit p (p +.+ vel) w) w
moveSpark :: World -> Spark -> (World, Maybe Spark)
moveSpark w sk
| magV (_skVel sk) < 1 = (w,Nothing)
| otherwise = case thingHit sp ep w of
Nothing -> (w, Just $ sk & skPos .~ ep & skVel .*.*~ 0.9 & skOldPos .~ sp)
Just (hp,hthing) -> (sparkDam sp ep (hp,hthing) w, Just $ sk & skPos .~ hp & skOldPos .~ sp & skVel .~ 0)
where
bt = bt'
dodrag = ptVel .*.*~ drag
drag = _ptDrag bt
(p:_) = _ptTrail bt
vel = _ptVel bt
hiteff = _ptHitEff bt
t = _ptTimer bt
sp = _skPos sk
ep = sp +.+ _skVel sk
sparkDam
:: Point2
-> Point2
-> (Point2, Either Creature Wall)
-> World
-> World
sparkDam sp ep mayEiCrWl = case mayEiCrWl of
(hitp,Left cr) -> creatures . ix (_crID cr) . crState . csDamage .:~ thedam hitp
(hitp,Right wl) -> wallDamages . ix (_wlID wl) .:~ thedam hitp
where
thedam hitp = Damage SPARKING 1 sp hitp ep NoDamageEffect
--import Control.Lens
-- TODO remove/simplify this function
createBarrelSpark :: Point2 -> Float -> Int -> Int -> World -> World
createBarrelSpark pos dir time colid = instantParticles .:~ PtSpark
{ _ptUpdate = mvSpark
, _ptVel = rotateV dir (V2 5 0)
, _ptDrag = 0.9
, _ptColor = numColor colid
, _ptTrail = [pos]
, _ptWidth = 1
, _ptTimer = time
, _ptHitEff = expireAndDamage basicSparkDams
createBarrelSpark :: Point2 -> Float -> Int -> World -> World
createBarrelSpark pos dir colid = sparks .:~ Spark
{ _skVel = rotateV dir (V2 5 0)
, _skColor = numColor colid
, _skPos = pos
, _skOldPos = pos
, _skWidth = 1
}
colSpark :: Int -> Color -> Point2 -> Float -> World -> World
colSpark :: 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
randColDirTimeSpark randcol randdir pos w = w
& sparks .:~ spark
& randGen .~ g
where
((col,dir,time),g) = (`runState` _randGen w) $ do
((col,dir),g) = (`runState` _randGen w) $ do
c <- randcol
d <- randdir
t <- randtime
return (c,d,t)
spark = PtSpark
{ _ptUpdate = mvSpark
, _ptDrag = 0.9
, _ptVel = rotateV dir (V2 5 0)
, _ptColor = col
, _ptTrail = [pos]
, _ptWidth = 1
, _ptTimer = time
, _ptHitEff = expireAndDamage basicSparkDams
return (c,d)
spark = Spark
{ _skVel = rotateV dir (V2 5 0)
, _skColor = col
, _skPos = pos
, _skOldPos = pos
, _skWidth = 1
}
colSparkRandDir :: Float -> Int -> Color -> Point2 -> Float -> World -> World
colSparkRandDir randDir time col pos baseDir w = w
& instantParticles .:~ spark
colSparkRandDir :: Float -> Color -> Point2 -> Float -> World -> World
colSparkRandDir randDir col pos baseDir w = w
& sparks .:~ spark
& randGen .~ g
where
(a,g) = randomR (-randDir,randDir) $ _randGen w
dir = a + baseDir
spark = PtSpark
{ _ptUpdate = mvSpark
, _ptDrag = 0.9
, _ptVel = rotateV dir (V2 5 0)
, _ptColor = col
, _ptTrail = [pos]
, _ptWidth = 1
, _ptTimer = time
, _ptHitEff = expireAndDamage basicSparkDams
spark = Spark
{ _skVel = rotateV dir (V2 5 0)
, _skColor = col
, _skPos = pos
, _skOldPos = pos
, _skWidth = 1
}
src/Dodge/Spark/Draw.hs
+9
View File
@@ -0,0 +1,9 @@
module Dodge.Spark.Draw where
import Dodge.Data
import Picture
drawSpark :: Spark -> Picture
drawSpark pt = setLayer BloomNoZWrite
. setDepth 20
. color (_skColor pt)
$ thickLine (_skWidth pt) [_skOldPos pt, _skPos pt]
src/Dodge/Update.hs
+7
View File
@@ -5,6 +5,7 @@ Description : Simulation update
-}
module Dodge.Update ( updateUniverse ) where
import Dodge.Data
import Dodge.Spark
import Dodge.Bullet
import Dodge.Update.Cloud
import Dodge.Machine.Update
@@ -81,6 +82,7 @@ functionalUpdate cfig w = checkEndGame
. resetWorldEvents
. dbArg _worldEvents
. updateIMl _modifications _mdUpdate
. updateSparks
. updateParticles
. updateBullets
. updateRadarBlips
@@ -220,6 +222,11 @@ updateBullets w = updateInstantBullets $ set bullets (catMaybes ps) w'
where
(w',ps) = mapAccumR updateBullet w $ _bullets w
updateSparks :: World -> World
updateSparks w = w' & sparks .~ catMaybes newsparks
where
(w',newsparks) = mapAccumR (\a b -> moveSpark a b) w $ _sparks w
{- Apply internal particle updates, delete 'Nothing's. -}
updateParticles :: World -> World
updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w'
src/Dodge/Wall/DamageEffect.hs
+6 -6
View File
@@ -20,8 +20,8 @@ defaultWallDamage dm wl = case _wlMaterial wl of
stoneWallDamage :: Damage -> Wall -> World -> (World,Int)
stoneWallDamage dm wl = case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a d $ colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a d $ colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a d $ wlDustAt wl outTo
SHATTERING -> a d $ muchWlDustAt wl outTo
CRUSHING -> a d id
@@ -46,8 +46,8 @@ stoneWallDamage dm wl = case _dmType dm of
windowWallDamage :: Damage -> Wall -> World -> (World,Int)
windowWallDamage dm wl w = w & case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a d $ dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a d $ dosplint . colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a d $ dosplint . wlDustAt wl outTo
SHATTERING -> a d $ dosplint . muchWlDustAt wl outTo
CRUSHING -> a d dosplint
@@ -78,8 +78,8 @@ windowWallDamage dm wl w = w & case _dmType dm of
crystalWallDamage :: Damage -> Wall -> World -> (World,Int)
crystalWallDamage dm wl = case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a 0 $ colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a 0 $ colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a 0 $ wlDustAt wl outTo
SHATTERING -> a d $ muchWlDustAt wl outTo
CRUSHING -> a 0 id