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

Modularise shockwaves, stop landing self damage when blinking

Browse Source
This commit is contained in:
jgk
2021-04-04 20:19:45 +02:00
parent b3649597fa
commit dfee9b2f37
8 changed files with 144 additions and 140 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+2 -2
View File
@@ -26,7 +26,7 @@ import Control.Concurrent
import Control.Lens
import Foreign (Word32)
import Control.Monad (when)
import Control.Monad (when,void)
import System.Random
@@ -53,7 +53,7 @@ main = do
(fmap (setWindowSize sizex sizey keyConfig) firstWorld)
( \preData w -> do
startTicks <- SDL.ticks
doDrawing (_renderData preData) w
void $ doDrawing (_renderData preData) w
playSoundQueue (_soundData preData) (_soundQueue w)
newSoundData <- playAndUpdate (_sounds w) (_soundData preData)
src/Dodge/CreatureAction.hs
+8 -4
View File
@@ -7,7 +7,7 @@ module Dodge.CreatureAction
where
-- imports {{{
import Dodge.CreatureAction.UseItem
import Dodge.WorldEvent.Shockwave
import Dodge.Data
import Dodge.Base
import Dodge.SoundLogic
@@ -222,7 +222,7 @@ createItemAt p it w = over floorItems (IM.insert i (set flItPos p
blinkAction :: Int -> World -> World
blinkAction n w = soundOnce teleSound $ set (creatures . ix n . crPos) p3
$ blinkShockwave p3
$ blinkShockwave n p3
$ inverseShockwaveAt cp 40 2 2 2
w
where p1 = _cameraCenter w +.+ (1 / _cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
@@ -231,8 +231,12 @@ blinkAction n w = soundOnce teleSound $ set (creatures . ix n . crPos) p3
r = 1.5 * _crRad (_creatures w IM.! n)
p3 = fromMaybe p1 (fmap ((\p -> moveAmountToward p r cp) . fst) p2)
blinkShockwave :: Point2 -> World -> World
blinkShockwave p = makeShockwaveAt p 40 1 2 cyan
blinkShockwave
:: Int -- ^ Blinking creature ID.
-> Point2
-> World
-> World
blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan
moveAmountToward :: Point2 -> Float -> Point2 -> Point2
moveAmountToward p1 am p2
src/Dodge/Item/Weapon.hs
-3
View File
@@ -920,9 +920,6 @@ flamerAngle = 0.3
aSelf :: Int -> World -> World
aSelf = blinkAction
reflect :: Float -> Float -> Float
reflect a b = a + 2*(a-b)
src/Dodge/Item/Weapon/Bullet.hs
+3 -2
View File
@@ -5,6 +5,7 @@ import Dodge.Base
import Dodge.WorldEvent
import Dodge.SoundLogic
import Dodge.RandomHelp
import Dodge.WorldEvent.Shockwave
import Dodge.Creature.Property
@@ -129,7 +130,7 @@ bulConCr' bt p cr w
where cid = _crID cr
sp = head $ _btTrail' bt
ep = sp +.+ _btVel' bt
mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white)
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
bulHitWall' :: Particle' -> Point2 -> Wall -> World -> World
bulHitWall' bt p x w = damageBlocks x
@@ -195,7 +196,7 @@ bulConWall' bt p wl w = damageBlocks wl
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
_ -> w
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white)
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
hvBulHitWall' :: Particle' -> Point2 -> Wall -> World -> World
hvBulHitWall' bt p x w = damageBlocks x
src/Dodge/WorldEvent.hs
+1 -46
View File
@@ -19,6 +19,7 @@ import Dodge.WorldEvent.Cloud
import Dodge.WorldEvent.HitEffect
import Dodge.WorldEvent.Explosion
import Dodge.WorldEvent.SpawnParticle
import Dodge.WorldEvent.Shockwave
import Dodge.LightSources
import Dodge.Data
@@ -38,52 +39,6 @@ import Data.Function
import Data.List
import qualified Data.IntMap.Strict as IM
shockWaveDamage :: Point2 -> Float -> Int -> World -> World
shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over creatures (IM.map f) w
where f cr | dist (_crPos cr) p < rad + _crRad cr = over (crState . crDamage)
((:) $ Concussive amount p 2 0.5 rad) cr
| otherwise = cr
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - (div amount 2)))
w
(_blIDs wall)
_ -> w
inverseShockwaveAt :: Point2 -> Float -> Int -> Float -> Float -> World -> World
inverseShockwaveAt p rad dam push pushexp = over particles' ((:) theShockwave)
where theShockwave
= Particle'
{ _ptDraw = const blank
, _ptUpdate' = moveInverseShockWave 10 p rad push pushexp
}
moveInverseShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle')
moveInverseShockWave 0 _ _ _ _ w _ = (w, Nothing)
moveInverseShockWave t p r push pushexp w pt
= (dams w, Just $ newupdate $ newpic pt )
where newupdate = set ptUpdate' $ moveInverseShockWave (t-1) p r push pushexp
newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p
$ color cyan $ thickCircle rad thickness)
rad = r - (4/40) * r * fromIntegral (10 - t)
thickness = (fromIntegral (10 - t))**2 * rad / 40
dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1))
w
(_blIDs wall)
_ -> w
damCr cr | dist (_crPos cr) p < rad + _crRad cr
= over (crState . crDamage)
((:) $ PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)))
cr
| otherwise = cr
createBarrelSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
createBarrelSpark time colid pos dir maycid w = over worldEvents
((.) $ ( over particles' ((:) spark)
src/Dodge/WorldEvent/Explosion.hs
+2 -72
View File
@@ -7,7 +7,7 @@ import Dodge.WorldEvent.SpawnParticle
import Dodge.WorldEvent.Flash
import Dodge.RandomHelp
import Dodge.SoundLogic
import Dodge.WorldEvent.Shockwave
import Geometry
import Picture
@@ -57,7 +57,7 @@ makeExplosionAt :: Point2 -> World -> World
makeExplosionAt p w = soundOnce grenadeBang
. addFlames
. explosionFlashAt p
$ makeShockwaveAt p 50 10 1 white
$ makeShockwaveAt [] p 50 10 1 white
w
where
fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w
@@ -74,73 +74,3 @@ makeExplosionAt p w = soundOnce grenadeBang
pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y)
$ collidePointWalls p q $ wallsNearPoint q w
makeShockwaveAt :: Point2 -> Float -> Int -> Float -> Color
-> World -> World
makeShockwaveAt p rad dam push col = over particles' ((:) theShockwave)
where theShockwave = shockwaveAt p rad dam push col 10
shockwaveAt :: Point2 -> Float -> Int -> Float -> Color -> Int -> Particle'
shockwaveAt p rad dam push col maxtime
= Shockwave'
{ _ptDraw = const blank
, _ptUpdate' = mvShockwave'
, _btColor' = col
, _btPos' = p
, _btRad' = rad
, _btDam' = dam
, _btPush' = push
, _btMaxTime' = maxtime
, _btTimer' = maxtime
}
mvShockwave' :: World -> Particle' -> (World, Maybe Particle')
mvShockwave' w pt
| _btTimer' pt <= 0 = (w, Nothing)
| otherwise
= (dams w , Just $ set btTimer' (t - 1) $ set ptDraw (const pic) pt)
where
r = _btRad' pt
p = _btPos' pt
push = _btPush' pt
dam = _btDam' pt
t = _btTimer' pt
tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
pic = onLayer PtLayer $ uncurry translate p
$ color (_btColor' pt) $ thickCircle rad thickness
rad = r - (3/4) * r * tFraction
thickness = tFraction**2 * r
dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1))
w
(_blIDs wall)
_ -> w
damCr cr | dist (_crPos cr) p < rad + _crRad cr
= over (crState . crDamage)
((:) $ PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p)))
cr
| otherwise = cr
moveShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle')
moveShockWave 0 _ _ _ _ w _ = (w, Nothing)
moveShockWave t p r push pushexp w pt
= (dams w, Just $ newupdate $ newpic pt )
where newupdate = set ptUpdate' $ moveShockWave (t-1) p r push pushexp
newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p
$ color cyan $ thickCircle rad thickness)
rad = r - (3/40) * r * fromIntegral t
thickness = (fromIntegral t)**2 * rad / 40
dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1))
w
(_blIDs wall)
_ -> w
damCr cr | dist (_crPos cr) p < rad + _crRad cr
= over (crState . crDamage)
((:) $ PushDam 1 (25 *.* safeNormalizeV (_crPos cr -.- p)))
cr
| otherwise = cr
src/Dodge/WorldEvent/Shockwave.hs
+114
View File
@@ -0,0 +1,114 @@
module Dodge.WorldEvent.Shockwave
( makeShockwaveAt
, inverseShockwaveAt
)
where
import Dodge.Data
import Dodge.Base
import Geometry
import Picture
import qualified Data.IntMap.Strict as IM
import Control.Lens
makeShockwaveAt
:: [Int] -- ^ IDs of invulnerable creatures.
-> Point2 -- ^ Center of shockwave.
-> Float -- ^ Maximal radius.
-> Int -- ^ Damage caused per frame.
-> Float -- ^ Amount of pushback per frame.
-> Color -- ^ Color of shockwave.
-> World -- ^ Start world.
-> 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'
{ _ptDraw = drawShockwave
, _ptUpdate' = mvShockwave' is
, _btColor' = col
, _btPos' = p
, _btRad' = rad
, _btDam' = dam
, _btPush' = push
, _btMaxTime' = maxtime
, _btTimer' = maxtime
}
drawShockwave :: Particle' -> Picture
drawShockwave pt = pic
where
pic = onLayer PtLayer $ uncurry 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
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)
where
r = _btRad' pt
p = _btPos' pt
push = _btPush' pt
dam = _btDam' pt
t = _btTimer' pt
tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
rad = r - (3/4) * r * tFraction
dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1))
w
(_blIDs wall)
_ -> 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
-------------------------------------------------
inverseShockwaveAt :: Point2 -> Float -> Int -> Float -> Float -> World -> World
inverseShockwaveAt p rad dam push pushexp = over particles' ((:) theShockwave)
where theShockwave
= Particle'
{ _ptDraw = const blank
, _ptUpdate' = moveInverseShockWave 10 p rad push pushexp
}
moveInverseShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle')
moveInverseShockWave 0 _ _ _ _ w _ = (w, Nothing)
moveInverseShockWave t p r push pushexp w pt
= (dams w, Just $ newupdate $ newpic pt )
where newupdate = set ptUpdate' $ moveInverseShockWave (t-1) p r push pushexp
newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p
$ color cyan $ thickCircle rad thickness)
rad = r - (4/40) * r * fromIntegral (10 - t)
thickness = (fromIntegral (10 - t))**2 * rad / 40
dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1))
w
(_blIDs wall)
_ -> w
damCr cr | dist (_crPos cr) p < rad + _crRad cr
= over (crState . crDamage)
((:) $ PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)))
cr
| otherwise = cr
src/Geometry/Intersect.hs
+14 -11
View File
@@ -115,17 +115,20 @@ ratIntersectLineLine a b c d = fmap toNumPoint2 $ myIntersectLineLine (toRatPoin
toNumPoint2 (x,y) = (fromRational x, fromRational y)
f = toRatPoint2 . roundPoint2
-- | Round the floats within a 'Point2' to the nearest integer.
-- Rounding jumps after intervals of .5:
--
-- >>> roundPoint (0.5,0.5001)
-- (0.0,1.0)
--
-- but is symmetric around 0:
--
-- >>> roundPoint2 (0.5,-0.5)
-- (0.0,0.0)
--
{- | Round the floats within a 'Point2' to the nearest integer.
__Examples__
Rounding jumps after intervals of .5:
>>> roundPoint (0.5,0.5001)
(0.0,1.0)
but is symmetric around 0:
>>> roundPoint2 (0.5,-0.5)
(0.0,0.0)
-}
roundPoint2 :: Point2 -> Point2
roundPoint2 (x,y) = (fromIntegral $ round x,fromIntegral $ round y)