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

Reify shockwaves

Browse Source
This commit is contained in:
justin
2022-07-24 00:20:28 +01:00
parent 97174535d8
commit 5b9e9968f3
17 changed files with 197 additions and 166 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Beam.hs
+1 -1
View File
@@ -51,7 +51,7 @@ teslaBeamCombine (p,(a,b,bm),(x,y,_)) w
lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> LaserStart
lasRayAt col dam phasev pos dir = LaserStart
{ _lpDamage = dam
{ _lpType = DamageLaser dam
, _lpPhaseV = phasev
, _lpPos = pos
, _lpDir = dir
src/Dodge/Bullet.hs
+1 -1
View File
@@ -83,7 +83,7 @@ bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World)
bulletSpawn bu = case _buSpawn bu of
BulSpark -> Nothing
BulBall IncBall -> Just incBallAt
BulBall ConcBall -> Just $ randParticleAt concBall
BulBall ConcBall -> Just $ \p -> shockwaves .:~ concBall p
BulBall TeslaBall -> Just makeStaticBall
hitEffFromBul :: Float -> Bullet
src/Dodge/Data.hs
+4 -16
View File
@@ -79,7 +79,9 @@ module Dodge.Data
, module Dodge.Data.PressPlate
, module Dodge.Data.Laser
, module Dodge.Data.TeslaArc
, module Dodge.Data.Shockwave
) where
import Dodge.Data.Shockwave
import Dodge.Data.TeslaArc
import Dodge.Data.Laser
import Dodge.Data.PressPlate
@@ -225,6 +227,7 @@ data World = World
, _newBeams :: WorldBeams
, _beams :: WorldBeams
, _teslaArcs :: [TeslaArc]
, _shockwaves :: [Shockwave]
, _lasers :: [LaserStart]
, _lasersToDraw :: [Laser]
, _walls :: IM.IntMap Wall
@@ -377,22 +380,7 @@ data WorldBeams = WorldBeams
{- Objects without ids.
Update themselves, perhaps with side effects. -}
data Particle
= PtTargetLaser
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptPoints :: [Point2]
, _ptColor :: Color
}
| Shockwave
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptColor :: Color
, _ptPos :: Point2
, _ptRad :: Float
, _ptDam :: Int
, _ptPush :: Float
, _ptMaxTime :: Int
, _ptTimer :: Int
}
| PtInvShockwave
= PtInvShockwave
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptColor :: Color
, _ptPos :: Point2
src/Dodge/Data/Laser.hs
+11 -2
View File
@@ -5,17 +5,26 @@ module Dodge.Data.Laser
import Color
import Geometry.Data
import Control.Lens
data LaserType = DamageLaser {_laserTypeDamage :: Int}
| TargetLaser
deriving (Eq,Ord,Show,Read)
data LaserStart = LaserStart
{ _lpDamage :: Int
, _lpPhaseV :: Float
{ _lpPhaseV :: Float
, _lpPos :: Point2
, _lpDir :: Float
, _lpColor :: Color
, _lpType :: LaserType
}
deriving (Eq,Ord,Show,Read)
data Laser = Laser
{ _laColor :: Color
, _laPoints :: [Point2]
, _laType :: LaserType
}
deriving (Eq,Ord,Show,Read)
makeLenses ''Laser
makeLenses ''LaserStart
makeLenses ''LaserType
src/Dodge/Data/Shockwave.hs
+22
View File
@@ -0,0 +1,22 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Shockwave
where
import Color
import Geometry.Data
import Control.Lens
data ShockwaveDirection = OutwardShockwave | InwardShockwave
deriving (Eq,Ord,Show,Read)
data Shockwave = Shockwave
{ _swColor :: Color
, _swDirection :: ShockwaveDirection
, _swInvulnerableCrs :: [Int]
, _swPos :: Point2
, _swRad :: Float
, _swDam :: Int
, _swPush :: Float
, _swMaxTime :: Int
, _swTimer :: Int
}
deriving (Eq,Ord,Show,Read)
makeLenses ''Shockwave
src/Dodge/Default/World.hs
+1
View File
@@ -46,6 +46,7 @@ defaultWorld = World
, _newBeams = WorldBeams [] [] [] []
, _beams = WorldBeams [] [] [] []
, _teslaArcs = []
, _shockwaves = []
, _lasers = []
, _lasersToDraw = []
, _walls = IM.empty
src/Dodge/Flame.hs
+1 -3
View File
@@ -59,9 +59,7 @@ doDamagesFL fdm (p,thhit) bt = case thhit of
dams = fdm bt p
{- TODO: add generalised area damage particles/hiteffects. -}
moveFlame :: World
-> Flame
-> (World, Maybe Flame)
moveFlame :: World -> Flame -> (World, Maybe Flame)
moveFlame w pt
| time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
| otherwise = case List.safeHead $ thingsHit sp ep w of
src/Dodge/Item/Weapon/Decoration.hs
-23
View File
@@ -1,23 +0,0 @@
{- |
Particles and pictures that decorate weapons, such as laser scopes etc.
-}
module Dodge.Item.Weapon.Decoration
( makeLaserScope
) where
import Dodge.Data
import Geometry.Data
import Picture
import Control.Lens
makeLaserScope
:: Point2 -- ^ Start point
-> Point2 -- ^ End point
-> Float -- ^ Fraction of red/green
-> Particle
makeLaserScope p ep relFrac = PtTargetLaser
{_ptUpdate = \w pt -> (w, Just $ pt & ptUpdate .~ \w' _ -> (w',Nothing))
, _ptPoints = [p,ep]
, _ptColor = col
}
where
col = mixColors relFrac (1-relFrac) red green
src/Dodge/Item/Weapon/ExtraEffect.hs
+6 -4
View File
@@ -141,10 +141,12 @@ targetLaserUpdate _ cr w t
(mp, ps) = reflectLaserAlong 0.2 sp ep w
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
addLaserPic = instantParticles .:~ PtTargetLaser
{ _ptUpdate = ptSimpleTime 1
, _ptPoints = sp:ps
, _ptColor = col
addLaserPic = lasers .:~ LaserStart
{ _lpPhaseV = 1
, _lpDir = _crDir cr
, _lpPos = sp
, _lpColor = col
, _lpType = TargetLaser
}
--wpammo = _itConsumption it
-- reloadFrac
src/Dodge/Laser/Update.hs
+8 -3
View File
@@ -5,16 +5,21 @@ import Dodge.WorldEvent.Damage
import Dodge.Data
import Geometry
import Control.Lens
import Data.Maybe
updateLaser :: World -> LaserStart -> (World, Laser)
updateLaser w pt =
( damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w
, Laser {_laPoints = sp:ps , _laColor = _lpColor pt}
( w'
, Laser {_laPoints = sp:ps , _laColor = _lpColor pt, _laType = _lpType pt}
)
where
w' = fromMaybe w $ do
dam <- pt ^? lpType . laserTypeDamage
return $ damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w
phasev = _lpPhaseV pt
sp = _lpPos pt
dir = _lpDir pt
dam = _lpDamage pt
xp = sp +.+ 800 *.* unitVectorAtAngle dir
(thHit, ps) = reflectLaserAlong phasev sp xp w
src/Dodge/Particle/Draw.hs
+18 -21
View File
@@ -5,22 +5,19 @@ import Picture
drawParticle :: Particle -> Picture
drawParticle pt = case pt of
Shockwave {} -> drawShockwave pt
PtInvShockwave {} -> drawInverseShockwave pt
PtTargetLaser {} -> drawTargetLaser pt
ShockLine {} -> drawSonicWave pt
drawShockwave :: Particle -> Picture
drawShockwave pt = setDepth 20
. setLayer BloomLayer
. uncurryV translate (_ptPos pt)
. color (_ptColor pt)
$ thickCircle rad thickness
where
r = _ptRad pt
thickness = tFraction**2 * r
rad = r - (3/4) * r * tFraction
tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt)
--
--drawShockwave :: Particle -> Picture
--drawShockwave pt = setDepth 20
-- . setLayer BloomLayer
-- . uncurryV translate (_ptPos pt)
-- . color (_ptColor pt)
-- $ thickCircle rad thickness
-- where
-- r = _ptRad pt
-- thickness = tFraction**2 * r
-- rad = r - (3/4) * r * tFraction
-- tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt)
drawInverseShockwave :: Particle -> Picture
drawInverseShockwave pt
@@ -41,14 +38,14 @@ drawInverseShockwave pt
-- where
-- ps = _ptPoints pt
drawTargetLaser :: Particle -> Picture
drawTargetLaser :: Laser -> Picture
drawTargetLaser pt = setLayer BloomNoZWrite $ pictures
[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 5 (sp:ps)
, setDepth 19.5 . color (brightX 5 1 col) $ thickLine 1 (sp:ps)
]
[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 5 (sp:ps)
, setDepth 19.5 . color (brightX 5 1 col) $ thickLine 1 (sp:ps)
]
where
col = _ptColor pt
(sp:ps) = _ptPoints pt
col = _laColor pt
(sp:ps) = _laPoints pt
drawSonicWave :: Particle -> Picture
drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20
src/Dodge/Render/ShapePicture.hs
+2
View File
@@ -1,6 +1,7 @@
module Dodge.Render.ShapePicture
( worldSPic
) where
import Dodge.Shockwave.Draw
import Dodge.Tesla.Arc.Draw
import Dodge.Laser.Draw
import Dodge.Cloud.Draw
@@ -128,6 +129,7 @@ cullPoint cfig w p
extraPics :: Configuration -> World -> Picture
extraPics cfig w = pictures (_decorations w)
<> concatMapPic drawShockwave (_shockwaves w)
<> concatMapPic drawLaser (_lasersToDraw w)
<> concatMapPic drawTeslaArc (_teslaArcs w)
<> concatMapPic drawParticle (_particles w)
src/Dodge/Shockwave/Draw.hs
+17
View File
@@ -0,0 +1,17 @@
module Dodge.Shockwave.Draw
where
import Dodge.Data.Shockwave
import Picture
import Geometry
drawShockwave :: Shockwave -> Picture
drawShockwave sw = setDepth 20
. setLayer BloomLayer
. uncurryV translate (_swPos sw)
. color (_swColor sw)
$ thickCircle rad thickness
where
r = _swRad sw
thickness = tFraction**2 * r
rad = r - (3/4) * r * tFraction
tFraction = fromIntegral (_swTimer sw) / fromIntegral (_swMaxTime sw)
src/Dodge/Shockwave/Update.hs
+67
View File
@@ -0,0 +1,67 @@
module Dodge.Shockwave.Update
where
import Geometry.Vector
import Dodge.Zoning.Wall
import Dodge.Base.Collide
import Dodge.Wall.Damage
import Dodge.Data
import qualified IntMapHelp as IM
import LensHelp
import Data.Foldable
updateShockwave :: World -> Shockwave -> (World,Maybe Shockwave)
updateShockwave w sw = case _swDirection sw of
OutwardShockwave -> moveShockwave w sw
InwardShockwave -> moveInverseShockwave w sw
moveShockwave :: World -> Shockwave -> (World,Maybe Shockwave)
moveShockwave w sw
| _swTimer sw <= 0 = ( w , Nothing)
| otherwise = (doDams w , Just $ sw & swTimer -~ 1)
where
is = _swInvulnerableCrs sw
r = _swRad sw
p = _swPos sw
push = _swPush sw
dam = _swDam sw
t = _swTimer sw
tFraction = fromIntegral t / fromIntegral (_swMaxTime sw)
rad = r - (3/4) * r * tFraction
doDams w' = over creatures (IM.map damCr)
$ foldl'
(flip $ damageWall (Damage EXPLOSIVE 10000 p p p NoDamageEffect))
w'
hitBlocks
hitBlocks = map snd . overlapCircWalls p rad $ wlsNearCirc p rad w
-- this is not expansive enough
damCr cr
| _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . csDamage .:~
Damage PUSHDAM dam (cpos -.- v) cpos (cpos +.+ v)
(PushBackDamage (25 * push))
where
cpos = _crPos cr
v = normalizeV (cpos -.- p)
moveInverseShockwave
:: World
-> Shockwave
-> (World, Maybe Shockwave)
moveInverseShockwave w sw
| t <= 0 = ( w, Nothing)
| otherwise = (dams w, Just $ swTimer -~ 1 $ sw )
where
p = _swPos sw
r = _swRad sw
t = _swTimer sw
rad = r - 0.1 * r * fromIntegral (10 - t)
dams = over creatures (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks
-- hitBlocks = wallsOnCirc' p rad $ wallsNearPoint' p w
damCr cr
| dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . csDamage .:~
Damage PUSHDAM 1 (cpos +.+ v) cpos (cpos -.- v) (PushBackDamage 25)
where
cpos = _crPos cr
v = normalizeV (cpos -.- p)
src/Dodge/Update.hs
+7
View File
@@ -4,6 +4,7 @@ Module : Dodge.Update
Description : Simulation update
-}
module Dodge.Update ( updateUniverse ) where
import Dodge.Shockwave.Update
import Dodge.Tesla.Arc
import Dodge.Laser.Update
import Dodge.PressPlate
@@ -90,6 +91,7 @@ functionalUpdate w = checkEndGame
. over uvWorld updateRadarSweeps
. over uvWorld updatePosEvents
. over uvWorld updateFlames
. over uvWorld updateShockwaves
. over uvWorld updateEnergyBalls
. over uvWorld updateParticles
. over uvWorld updateBullets
@@ -243,6 +245,11 @@ updateBullets w = updateInstantBullets $ set bullets (catMaybes ps) w'
where
(w',ps) = mapAccumR updateBullet w $ _bullets w
updateShockwaves :: World -> World
updateShockwaves w = w' & shockwaves .~ catMaybes newflames
where
(w',newflames) = mapAccumR updateShockwave w $ _shockwaves w
updateFlames :: World -> World
updateFlames w = w' & flames .~ catMaybes newflames
where
src/Dodge/WorldEvent/Shockwave.hs
+20 -82
View File
@@ -1,8 +1,6 @@
module Dodge.WorldEvent.Shockwave
( makeShockwaveAt
, inverseShockwaveAt
, drawShockwave
, mvShockwave
) where
import Dodge.Zoning.Wall
import Dodge.Data
@@ -24,58 +22,18 @@ makeShockwaveAt
-> Color -- ^ Color of shockwave.
-> World -- ^ Start world.
-> World
makeShockwaveAt is p rad dam push col = instantParticles .:~ Shockwave
{ _ptUpdate = mvShockwave is
, _ptColor = col
, _ptPos = p
, _ptRad = rad
, _ptDam = dam
, _ptPush = push
, _ptMaxTime = 10
, _ptTimer = 10
makeShockwaveAt is p rad dam push col = shockwaves .:~ Shockwave
{ _swInvulnerableCrs = is
, _swDirection = OutwardShockwave
, _swColor = col
, _swPos = p
, _swRad = rad
, _swDam = dam
, _swPush = push
, _swMaxTime = 10
, _swTimer = 10
}
{- Shockwave picture. -}
drawShockwave :: Particle -> Picture
drawShockwave pt = setDepth 20
. setLayer BloomLayer
. uncurryV translate (_ptPos pt)
. color (_ptColor pt)
$ thickCircle rad thickness
where
r = _ptRad pt
thickness = tFraction**2 * r
rad = r - (3/4) * r * tFraction
tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt)
mvShockwave
:: [Int] -- ^ IDs of invulnerable creatures.
-> World -> Particle -> (World, Maybe Particle)
mvShockwave is w pt
| _ptTimer pt <= 0 = ( w , Nothing)
| otherwise = (doDams w , Just $ pt & ptTimer -~ 1)
where
r = _ptRad pt
p = _ptPos pt
push = _ptPush pt
dam = _ptDam pt
t = _ptTimer pt
tFraction = fromIntegral t / fromIntegral (_ptMaxTime pt)
rad = r - (3/4) * r * tFraction
doDams w' = over creatures (IM.map damCr)
$ foldl'
(flip $ damageWall (Damage EXPLOSIVE 10000 p p p NoDamageEffect))
w'
hitBlocks
hitBlocks = map snd . overlapCircWalls p rad $ wlsNearCirc p rad w
-- this is not expansive enough
damCr cr
| _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . csDamage .:~
Damage PUSHDAM dam (cpos -.- v) cpos (cpos +.+ v)
(PushBackDamage (25 * push))
where
cpos = _crPos cr
v = normalizeV (cpos -.- p)
{- Create a shockwave going from an outside circle into a center point. -}
inverseShockwaveAt
:: Point2 -- Center position
@@ -84,34 +42,14 @@ inverseShockwaveAt
-> Float -- Push amount
-> World
-> World
inverseShockwaveAt p rad dam push = instantParticles .:~ Shockwave
{ _ptUpdate = moveInverseShockwave
, _ptColor = cyan
, _ptPos = p
, _ptRad = rad
, _ptDam = dam
, _ptPush = push
, _ptMaxTime = 10
, _ptTimer = 10
inverseShockwaveAt p rad dam push = shockwaves .:~ Shockwave
{ _swDirection = InwardShockwave
, _swInvulnerableCrs = []
, _swColor = cyan
, _swPos = p
, _swRad = rad
, _swDam = dam
, _swPush = push
, _swMaxTime = 10
, _swTimer = 10
}
moveInverseShockwave
:: World
-> Particle
-> (World, Maybe Particle)
moveInverseShockwave w pt
| t <= 0 = ( w, Nothing)
| otherwise = (dams w, Just $ ptTimer -~ 1 $ pt )
where
p = _ptPos pt
r = _ptRad pt
t = _ptTimer pt
rad = r - 0.1 * r * fromIntegral (10 - t)
dams = over creatures (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks
-- hitBlocks = wallsOnCirc' p rad $ wallsNearPoint' p w
damCr cr
| dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . csDamage .:~
Damage PUSHDAM 1 (cpos +.+ v) cpos (cpos -.- v) (PushBackDamage 25)
where
cpos = _crPos cr
v = normalizeV (cpos -.- p)
src/Dodge/WorldEvent/SpawnParticle.hs
+11 -10
View File
@@ -30,16 +30,17 @@ makeStaticBall p = randEnergyBallAt aStaticBall p . (posEvents .:~ thesparker)
where
thesparker = PosEvent SparkSpawner 10 p
concBall :: Point2 -> State g Particle
concBall p = return Shockwave
{ _ptUpdate = mvShockwave []
, _ptColor = white
, _ptPos = p
, _ptRad = 15
, _ptDam = 4
, _ptPush = 1
, _ptMaxTime = 10
, _ptTimer = 10
concBall :: Point2 -> Shockwave
concBall p = Shockwave
{ _swDirection = OutwardShockwave
, _swInvulnerableCrs = []
, _swColor = white
, _swPos = p
, _swRad = 15
, _swDam = 4
, _swPush = 1
, _swMaxTime = 10
, _swTimer = 10
}
aStaticBall :: Point2 -> State g EnergyBall