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

Refactor inverse shockwave

Browse Source
This commit is contained in:
justin
2021-09-26 12:09:44 +01:00
parent a823d4c6df
commit 79b2692199
15 changed files with 87 additions and 94 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+1 -1
View File
@@ -171,7 +171,7 @@ blinkAction cr w
. over radDistortion (distortionBulge ++)
. set (creatures . ix cid . crPos) p3
. blinkShockwave cid p3
$ inverseShockwaveAt cpos 40 2 2 2 w
$ inverseShockwaveAt cpos 40 2 2 w
where
distR = 120
distortionBulge =
src/Dodge/Data.hs
+5 -5
View File
@@ -402,18 +402,18 @@ Update themselves, perhaps with side effects. -}
data Particle
= Particle
{ _ptDraw :: Particle -> Picture
, _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
}
| LinearParticle
{ _ptDraw :: Particle -> Picture
, _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptPoints :: [Point2]
, _ptTimer :: Int
, _ptColor :: Color
}
| BulletPt
{ _ptDraw :: Particle -> Picture
, _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _btVel' :: Point2
, _btColor' :: Color
, _btTrail' :: [Point2]
@@ -424,7 +424,7 @@ data Particle
}
| PtZ
{ _ptDraw :: Particle -> Picture
, _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _btVel' :: Point2
, _btColor' :: Color
, _btPos' :: Point2
@@ -436,7 +436,7 @@ data Particle
}
| Shockwave'
{ _ptDraw :: Particle -> Picture
, _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _btColor' :: Color
, _btPos' :: Point2
, _btRad' :: Float
src/Dodge/Item/Weapon/Decoration.hs
+1 -1
View File
@@ -21,7 +21,7 @@ makeLaserScope p ep relFrac = Particle
,lineAlphaThick 0.2 1.5
,lineAlphaThick 0.1 2
]
,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing))
,_ptUpdate = \w pt -> (w, Just $ pt & ptUpdate .~ \w' _ -> (w',Nothing))
}
where
lineAlphaThick a w =
src/Dodge/Item/Weapon/Grenade.hs
+1 -1
View File
@@ -21,7 +21,7 @@ moveGrenade :: Prop -> World -> World
moveGrenade pj w
| _pjTimer pj <= 0 = w
& props %~ IM.delete pID
& (_pjPayload pj) (_pjPos (_props w IM.! pID))
& _pjPayload pj (_pjPos (_props w IM.! pID))
| otherwise = case collideCircWalls oldPos newPos 4 $ wallsNearPoint newPos w of
Nothing -> w & props . ix pID %~ normalUpdate
Just (p,v) -> w
src/Dodge/Item/Weapon/Laser.hs
+2 -2
View File
@@ -44,7 +44,7 @@ charToPhaseV _ = error "Trying to set an undefined phaseV"
makeLaserAt :: Float -> Point2 -> Float -> Particle
makeLaserAt phaseV pos dir = Particle
{ _ptDraw = const blank
, _ptUpdate' = moveLaser phaseV pos dir
, _ptUpdate = moveLaser phaseV pos dir
}
moveLaser
@@ -56,7 +56,7 @@ moveLaser
-> (World, Maybe Particle)
moveLaser phaseV pos dir w pt
= ( set randGen g $ hitEffect w
, Just pt {_ptDraw = const pic ,_ptUpdate' = ptTimer' 0 }
, Just pt {_ptDraw = const pic ,_ptUpdate = ptTimer' 0 }
)
where
xp = pos +.+ 800 *.* unitVectorAtAngle dir
src/Dodge/Item/Weapon/UseEffect.hs
+6 -6
View File
@@ -28,7 +28,7 @@ aRadarPulse cr = over particles (radarPulseAt (_crPos cr) :)
blipAt :: Point2 -> Color -> Int -> Particle
blipAt p col i = Particle
{_ptDraw = const blank
,_ptUpdate' = mvBlip p col i i
,_ptUpdate = mvBlip p col i i
}
mvBlip :: Point2 -> Color
-> Int -- ^ Max possible timer value
@@ -37,7 +37,7 @@ mvBlip :: Point2 -> Color
mvBlip _ _ _ 0 w _ = (w, Nothing)
mvBlip p col maxt t w pt =
(w
, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
, Just $ pt & ptUpdate .~ mvBlip p col maxt (t-1)
& ptDraw .~ ( const
. setDepth (-0.5)
. setLayer 1
@@ -47,7 +47,7 @@ mvBlip p col maxt t w pt =
)
{- | An outwardly increasing circle that draws creatures, even those behind walls. -}
sonarPulseAt :: Point2 -> Particle
sonarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate' = mvSonar 100 p }
sonarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate = mvSonar 100 p }
mvSonar
:: Int -- ^ Timer
@@ -55,7 +55,7 @@ mvSonar
-> World -> Particle -> (World, Maybe Particle)
mvSonar 0 _ w _ = (w, Nothing)
mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
,_ptUpdate' = mvSonar (x-1) p
,_ptUpdate = mvSonar (x-1) p
}
)
where
@@ -77,7 +77,7 @@ An outwardly increasing circle that displays walls, even those behind other wall
radarPulseAt :: Point2 -> Particle
radarPulseAt p = Particle
{ _ptDraw = const blank
, _ptUpdate' = mvRadar 50 p
, _ptUpdate = mvRadar 50 p
}
mvRadar
:: Int -- ^ Timer
@@ -86,7 +86,7 @@ mvRadar
mvRadar 0 _ w _ = (w, Nothing)
mvRadar x p w pt =
( putBlips w
, Just $ pt {_ptDraw = const pic ,_ptUpdate' = mvRadar (x-1) p }
, Just $ pt {_ptDraw = const pic ,_ptUpdate = mvRadar (x-1) p }
)
where
pic = onLayerL [levLayer ShadowLayer, 1] $ pictures sweepPics
src/Dodge/Particle/Bullet/Spawn.hs
+4 -4
View File
@@ -18,7 +18,7 @@ aGenBulAt
-> Particle
aGenBulAt maycid pos vel hiteff width = BulletPt
{ _ptDraw = drawBul
, _ptUpdate' = mvGenBullet
, _ptUpdate = mvGenBullet
, _btVel' = vel
, _btColor' = V4 2 2 2 2
, _btTrail' = [pos]
@@ -37,7 +37,7 @@ aDelayedBulAt
-> Particle
aDelayedBulAt vfact maycid pos vel hiteff width = BulletPt
{ _ptDraw = drawBul
, _ptUpdate' = \w -> resetVel . mvGenBullet w
, _ptUpdate = \w -> resetVel . mvGenBullet w
, _btVel' = vfact *.* vel
, _btColor' = V4 2 2 2 2
, _btTrail' = [pos]
@@ -47,7 +47,7 @@ aDelayedBulAt vfact maycid pos vel hiteff width = BulletPt
, _btHitEffect' = hiteff
}
where
resetVel = second $ fmap $ (ptUpdate' .~ mvGenBullet) . (btVel' .~ vel)
resetVel = second $ fmap $ (ptUpdate .~ mvGenBullet) . (btVel' .~ vel)
aCurveBulAt
:: Maybe Int -- ^ Pass-through creature id
@@ -60,7 +60,7 @@ aCurveBulAt
-> Particle
aCurveBulAt maycid col pos control targ hiteff width = BulletPt
{ _ptDraw = drawBul
, _ptUpdate' = \w -> mvGenBullet w . setVel
, _ptUpdate = \w -> mvGenBullet w . setVel
, _btVel' = V2 0 0
, _btColor' = col
, _btTrail' = [pos]
src/Dodge/Render/Shape.hs
+2 -2
View File
@@ -12,8 +12,8 @@ import Dodge.Render.ShapePicture
import qualified Data.IntMap as IM
worldShape :: World -> Shape
worldShape w = _foregroundShape w
<> foldMap (crShape w) (IM.elems $ IM.filter (pointIsClose . _crPos) (_creatures w))
<> (foldMap (_spShape . floorItemSPic) $ IM.elems $ IM.filter (pointIsClose . _flItPos) $ _floorItems w)
<> foldMap (crShape w) (IM.filter (pointIsClose . _crPos) (_creatures w))
<> foldMap (_spShape . floorItemSPic) (IM.filter (pointIsClose . _flItPos) $ _floorItems w)
<> foldMap (_spShape . dbArg _prDraw) (IM.filter (pointIsClose . _pjPos) $ _props w)
where
pointIsClose p = dist camCen p < winSize
src/Dodge/Update.hs
+1 -1
View File
@@ -129,7 +129,7 @@ Apply internal particle updates, delete 'Nothing's. -}
updateParticles :: World -> World
updateParticles w = set particles (catMaybes ps) w'
where
(w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles w
(w',ps) = mapAccumR (\a b -> _ptUpdate b a b) w $ _particles w
-- Note that this updates the randgen
updateCreatures :: World -> World
src/Dodge/WorldEvent.hs
+1 -1
View File
@@ -36,7 +36,7 @@ createBarrelSpark pos dir maycid time colid w
where
spark = BulletPt
{ _ptDraw = drawBul
, _ptUpdate' = mvGenBullet
, _ptUpdate = mvGenBullet
, _btVel' = rotateV dir (V2 5 0)
, _btColor' = numColor colid
, _btTrail' = [pos]
src/Dodge/WorldEvent/Flash.hs
+3 -3
View File
@@ -60,7 +60,7 @@ glareBetween :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> M
glareBetween 0 _ _ _ _ _ _ = Nothing
glareBetween t len wdth col a b w = Just $ Particle
{_ptDraw = const $ lowLightPic len wdth col (a,b) w
,_ptUpdate' = \ w' _ -> (w',glareBetween (t-1) len wdth col a b w')
,_ptUpdate = \ w' _ -> (w',glareBetween (t-1) len wdth col a b w')
}
lowLightPic :: Float -> Float -> Color -> (Point2, Point2) -> World -> Picture
@@ -81,7 +81,7 @@ flashFlareAt :: Color -> Float -> Point2 -> Particle
flashFlareAt col alphax (V2 x y) = Particle
{ _ptDraw = const $ setLayer 2 . setDepth (-0.9) . translate x y
$ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
, _ptUpdate' = ptTimer' 1
, _ptUpdate = ptTimer' 1
}
explosionFlashAt :: Point2 -> World -> World
@@ -109,7 +109,7 @@ muzzleFlashPt (V2 x y) = Particle
. setLayer 2
. translate x y
$ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
, _ptUpdate' = ptTimer' 1
, _ptUpdate = ptTimer' 1
}
laserScopeTargetGlow :: Color -> Point2 -> World -> World
src/Dodge/WorldEvent/HelperParticle.hs
+1 -1
View File
@@ -6,4 +6,4 @@ import Dodge.Data
{- A simple timer update for particles. -}
ptTimer' :: Int -> World -> Particle -> (World, Maybe Particle)
ptTimer' 0 w _ = (w, Nothing)
ptTimer' n w pt = (w, Just $ pt {_ptUpdate' = ptTimer' (n-1)})
ptTimer' n w pt = (w, Just $ pt {_ptUpdate = ptTimer' (n-1)})
src/Dodge/WorldEvent/Shockwave.hs
+54 -61
View File
@@ -27,46 +27,36 @@ makeShockwaveAt
-> World
makeShockwaveAt is p rad dam push col = over particles (theShockwave :)
where
theShockwave = shockwaveAt is p rad dam push col 10
shockwaveAt
:: [Int] -- ^ IDs of invulnerable creatures.
-> Point2 -> Float -> Int -> Float -> Color -> Int -> Particle
shockwaveAt is p rad dam push col maxtime
= Shockwave'
theShockwave = Shockwave'
{ _ptDraw = drawShockwave
, _ptUpdate' = mvShockwave is
, _ptUpdate = mvShockwave is
, _btColor' = col
, _btPos' = p
, _btRad' = rad
, _btDam' = dam
, _btPush' = push
, _btMaxTime' = maxtime
, _btTimer' = maxtime
, _btMaxTime' = 10
, _btTimer' = 10
}
{-
Shockwave picture.
-}
{- Shockwave picture. -}
drawShockwave :: Particle -> Picture
drawShockwave pt = pic
drawShockwave pt = setDepth 20
. setLayer 1
. uncurryV translate (_btPos' pt)
. color (_btColor' pt)
$ thickCircle rad thickness
where
pic = setDepth 20 . setLayer 1 . uncurryV translate p
$ color (_btColor' pt) $ thickCircle rad thickness
p = _btPos' pt
r = _btRad' pt
thickness = tFraction**2 * r
rad = r - (3/4) * r * tFraction
tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
t = _btTimer' pt
tFraction = fromIntegral (_btTimer' pt) / fromIntegral (_btMaxTime' pt)
mvShockwave
:: [Int] -- ^ IDs of invulnerable creatures.
-> World -> Particle -> (World, Maybe Particle)
mvShockwave is w pt
| _btTimer' pt <= 0 = (w, Nothing)
| otherwise
= (dams w , Just $ set btTimer' (t - 1) pt) -- $ set ptDraw (const pic) pt)
| _btTimer' pt <= 0 = ( w , Nothing)
| otherwise = (doDams w , Just $ pt & btTimer' -~ 1)
where
r = _btRad' pt
p = _btPos' pt
@@ -75,56 +65,59 @@ mvShockwave is w pt
t = _btTimer' pt
tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
rad = r - (3/4) * r * tFraction
dams = over creatures (IM.map damCr) . flip (IM.foldr (damageBlocksBy 1)) hitBlocks
doDams = over creatures (IM.map damCr) . flip (IM.foldl' (flip $ damageBlocksBy 1)) hitBlocks
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damCr cr | _crID cr `elem` is = cr
| dist (_crPos cr) p < rad + _crRad cr
= over (crState . crDamage)
((:) $ PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p)))
cr
| otherwise = cr
-------------------------------------------------
{-
Create a shockwave going from an outside circle into a center point.
-}
damCr cr
| _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . crDamage %~
(PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p)) : )
{- Create a shockwave going from an outside circle into a center point. -}
inverseShockwaveAt
:: Point2 -- Center position
-> Float -- Radius
-> Int -- Damage
-> Float -- Push amount
-> Float -- Push amount parameter
-> World
-> World
inverseShockwaveAt p rad _ push pushexp = over particles (theShockwave :)
inverseShockwaveAt p rad dam push = over particles (theShockwave :)
where
theShockwave = Particle
{ _ptDraw = const blank
, _ptUpdate' = moveInverseShockWave 10 p rad push pushexp
theShockwave = Shockwave'
{ _ptDraw = drawInverseShockwave
, _ptUpdate = moveInverseShockwave
, _btColor' = cyan
, _btPos' = p
, _btRad' = rad
, _btDam' = dam
, _btPush' = push
, _btMaxTime' = 10
, _btTimer' = 10
}
moveInverseShockWave
:: Int -- ^ Timer
-> Point2 -- ^ Center position
-> Float -- ^ Radius
-> Float -- ^ Push amount
-> Float -- ^ Push amount parameter
-> World
moveInverseShockwave
:: World
-> Particle
-> (World, Maybe Particle)
moveInverseShockWave 0 _ _ _ _ w _ = (w, Nothing)
moveInverseShockWave t p r push pushexp w pt
= (dams w, Just $ newupdate $ newpic pt )
moveInverseShockwave w pt
| t <= 0 = ( w, Nothing)
| otherwise = (dams w, Just $ btTimer' -~ 1 $ pt )
where
newupdate = set ptUpdate' $ moveInverseShockWave (t-1) p r push pushexp
newpic = set ptDraw (const $ onLayer PtLayer $ uncurryV translate p
$ color cyan $ thickCircle rad thickness)
rad = r - (4/40) * r * fromIntegral (10 - t)
thickness = fromIntegral (10 - t) **2 * rad / 40
p = _btPos' pt
r = _btRad' pt
t = _btTimer' 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
= over (crState . crDamage)
((:) $ PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)))
cr
| otherwise = cr
damCr cr
| dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . crDamage %~
(PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)) :)
drawInverseShockwave :: Particle -> Picture
drawInverseShockwave pt
= setLayer 1 $ onLayer PtLayer $ uncurryV translate p
$ color cyan $ thickCircle rad thickness
where
p = _btPos' pt
r = _btRad' pt
t = _btTimer' pt
rad = r - 0.1 * r * fromIntegral (10 - t)
thickness = fromIntegral (10 - t) **2 * rad / 40
src/Dodge/WorldEvent/SpawnParticle.hs
+4 -4
View File
@@ -44,7 +44,7 @@ aFlameParticle
-> Particle
aFlameParticle t pos vel maycid = PtZ
{ _ptDraw = drawFlame vel
, _ptUpdate' = moveFlame vel
, _ptUpdate = moveFlame vel
, _btVel' = vel
, _btColor' = red
, _btPos' = pos
@@ -152,7 +152,7 @@ makeFlameletTimed (V2 x y) z vel maycid size time w = w
where
theFlamelet = PtZ
{ _ptDraw = drawFlameletZ rot
, _ptUpdate' = moveFlamelet
, _ptUpdate = moveFlamelet
, _btVel' = vel
, _btColor' = red
, _btPos' = V2 x y
@@ -307,7 +307,7 @@ makeTeslaArcAt :: Color -> Point2 -> Float -> Particle
makeTeslaArcAt col pos dir = LinearParticle
{ _ptPoints = [pos]
, _ptDraw = drawTeslaArc
, _ptUpdate' = moveTeslaArc pos dir
, _ptUpdate = moveTeslaArc pos dir
, _ptTimer = 2
, _ptColor = brightX 100 1.5 col
}
@@ -460,7 +460,7 @@ createSparkCol time col pos dir w
where
spark = BulletPt
{ _ptDraw = drawBul
, _ptUpdate' = mvGenBullet
, _ptUpdate = mvGenBullet
, _btVel' = rotateV dir (V2 5 0)
, _btColor' = col
, _btTrail' = [pos]
src/Loop.hs
+1 -1
View File
@@ -1,4 +1,4 @@
{-# LANGUAGE TupleSections #-}
--{-# LANGUAGE TupleSections #-}
{- |
Module : Loop
Description : Simple game loop