Refactor, try to limit dependencies
This commit is contained in:
@@ -1,51 +1,58 @@
|
||||
module Dodge.WorldEvent.Cloud
|
||||
( makeFlamerSmokeAt
|
||||
, smokeCloudAt
|
||||
, makeThinSmokeAt
|
||||
, makeThickSmokeAt
|
||||
, shellTrailCloud
|
||||
, spawnSmokeAtCursor
|
||||
, makeStartCloudAt
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Geometry.Data
|
||||
import Picture
|
||||
import LensHelp
|
||||
module Dodge.WorldEvent.Cloud (
|
||||
makeFlamerSmokeAt,
|
||||
smokeCloudAt,
|
||||
makeThinSmokeAt,
|
||||
makeThickSmokeAt,
|
||||
shellTrailCloud,
|
||||
spawnSmokeAtCursor,
|
||||
makeStartCloudAt,
|
||||
) where
|
||||
|
||||
import Dodge.Base
|
||||
import Dodge.Data.World
|
||||
import Geometry.Data
|
||||
import LensHelp
|
||||
import Picture
|
||||
--import qualified Streaming.Prelude as S
|
||||
--import Control.Lens
|
||||
import System.Random
|
||||
|
||||
makeCloudAt
|
||||
:: CloudDraw
|
||||
-> Float -- ^ radius
|
||||
-> Int -- ^ timer
|
||||
-> Float -- ^ resting altitude
|
||||
-> Point3 -- start position
|
||||
-> World
|
||||
-> World
|
||||
makeCloudAt drawFunc rad t alt p = cWorld . clouds .:~ Cloud
|
||||
--makeCloudAt drawFunc rad t alt p = clouds %~ S.cons Cloud
|
||||
{ _clPos = p
|
||||
, _clVel = V3 0 0 0
|
||||
, _clPict = drawFunc
|
||||
, _clRad = rad
|
||||
, _clAlt = alt
|
||||
, _clTimer = t
|
||||
, _clType = SmokeCloud
|
||||
}
|
||||
|
||||
smokeCloudAt
|
||||
:: Color
|
||||
-> Float -- ^ radius
|
||||
-> Int -- ^ timer
|
||||
-> Float -- ^ resting altitude
|
||||
-> Point3 -- start position
|
||||
-> World
|
||||
-> World
|
||||
smokeCloudAt col = makeCloudAt (CloudColor (4/3) 800 col)
|
||||
makeCloudAt ::
|
||||
CloudDraw ->
|
||||
-- | radius
|
||||
Float ->
|
||||
-- | timer
|
||||
Int ->
|
||||
-- | resting altitude
|
||||
Float ->
|
||||
Point3 -> -- start position
|
||||
World ->
|
||||
World
|
||||
makeCloudAt drawFunc rad t alt p =
|
||||
cWorld . clouds
|
||||
.:~ Cloud
|
||||
{ --makeCloudAt drawFunc rad t alt p = clouds %~ S.cons Cloud
|
||||
_clPos = p
|
||||
, _clVel = V3 0 0 0
|
||||
, _clPict = drawFunc
|
||||
, _clRad = rad
|
||||
, _clAlt = alt
|
||||
, _clTimer = t
|
||||
, _clType = SmokeCloud
|
||||
}
|
||||
|
||||
smokeCloudAt ::
|
||||
Color ->
|
||||
-- | radius
|
||||
Float ->
|
||||
-- | timer
|
||||
Int ->
|
||||
-- | resting altitude
|
||||
Float ->
|
||||
Point3 -> -- start position
|
||||
World ->
|
||||
World
|
||||
smokeCloudAt col = makeCloudAt (CloudColor (4 / 3) 800 col)
|
||||
|
||||
makeThickSmokeAt :: Point3 -> World -> World
|
||||
makeThickSmokeAt = makeCloudAt (CloudColor 4 50 black) 3 50 30
|
||||
@@ -57,12 +64,12 @@ makeStartCloudAt :: Point3 -> World -> World
|
||||
makeStartCloudAt = makeCloudAt (CloudColor 2 800 white) 10 400 5
|
||||
|
||||
shellTrailCloud :: Point3 -> World -> World
|
||||
shellTrailCloud = makeCloudAt (CloudColor (4/3) 800 (greyN 0.5)) 15 400 40
|
||||
shellTrailCloud = makeCloudAt (CloudColor (4 / 3) 800 (greyN 0.5)) 15 400 40
|
||||
|
||||
makeFlamerSmokeAt :: Point3 -> World -> World
|
||||
makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w
|
||||
where
|
||||
x = fst $ randomR (0.5,0.8) (_randGen w)
|
||||
x = fst $ randomR (0.5, 0.8) (_randGen w)
|
||||
|
||||
spawnSmokeAtCursor :: World -> World
|
||||
spawnSmokeAtCursor w = shellTrailCloud (V3 x y 20) w
|
||||
|
||||
@@ -1,19 +1,20 @@
|
||||
module Dodge.WorldEvent.Damage
|
||||
( damThingHitWith
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Geometry
|
||||
module Dodge.WorldEvent.Damage (
|
||||
damThingHitWith,
|
||||
) where
|
||||
|
||||
import Dodge.Data.World
|
||||
import Dodge.Wall.Damage
|
||||
import Geometry
|
||||
import LensHelp
|
||||
|
||||
damThingHitWith
|
||||
:: (Point2 -> Point2 -> Point2 -> Damage)
|
||||
-> Point2
|
||||
-> Point2
|
||||
-> Maybe (Point2, Either Creature Wall)
|
||||
-> World
|
||||
-> World
|
||||
damThingHitWith ::
|
||||
(Point2 -> Point2 -> Point2 -> Damage) ->
|
||||
Point2 ->
|
||||
Point2 ->
|
||||
Maybe (Point2, Either Creature Wall) ->
|
||||
World ->
|
||||
World
|
||||
damThingHitWith partDT sp ep mayEiCrWl = case mayEiCrWl of
|
||||
Just (hitp,Left cr) -> cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ partDT sp hitp ep
|
||||
Just (hitp,Right wl) -> damageWall (partDT sp hitp ep) wl
|
||||
Just (hitp, Left cr) -> cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ partDT sp hitp ep
|
||||
Just (hitp, Right wl) -> damageWall (partDT sp hitp ep) wl
|
||||
Nothing -> id
|
||||
|
||||
@@ -1,96 +1,108 @@
|
||||
{-
|
||||
Explosions: creation of shockwave and particles at a given point.
|
||||
-}
|
||||
module Dodge.WorldEvent.Explosion
|
||||
( makeExplosionAt
|
||||
, makeFlameExplosionAt
|
||||
, makePoisonExplosionAt
|
||||
, makeTeslaExplosionAt
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.EnergyBall
|
||||
import Dodge.LightSource
|
||||
import Dodge.Flame
|
||||
import Dodge.Base.Collide
|
||||
import Dodge.WorldEvent.SpawnParticle
|
||||
module Dodge.WorldEvent.Explosion (
|
||||
makeExplosionAt,
|
||||
makeFlameExplosionAt,
|
||||
makePoisonExplosionAt,
|
||||
makeTeslaExplosionAt,
|
||||
) where
|
||||
|
||||
--import Dodge.WorldEvent.Flash
|
||||
import RandomHelp
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.WorldEvent.Shockwave
|
||||
import Geometry
|
||||
|
||||
--import Geometry.Vector3D
|
||||
import Picture
|
||||
import LensHelp
|
||||
|
||||
import Data.List
|
||||
import Dodge.Base.Collide
|
||||
import Dodge.Data.World
|
||||
import Dodge.EnergyBall
|
||||
import Dodge.Flame
|
||||
import Dodge.LightSource
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.WorldEvent.Shockwave
|
||||
import Dodge.WorldEvent.SpawnParticle
|
||||
import Geometry
|
||||
import LensHelp
|
||||
import Picture
|
||||
import RandomHelp
|
||||
|
||||
--import Data.Maybe
|
||||
|
||||
makePoisonExplosionAt
|
||||
:: Point2 -- ^ Position
|
||||
-> World
|
||||
-> World
|
||||
makePoisonExplosionAt p w
|
||||
= soundMultiFrom [Explosion 0,Explosion 1] p bangS Nothing
|
||||
$ foldl' (flip $ makeGasCloud p) w
|
||||
$ replicateM 25 (randInCirc 2) & evalState $ _randGen w
|
||||
makePoisonExplosionAt ::
|
||||
-- | Position
|
||||
Point2 ->
|
||||
World ->
|
||||
World
|
||||
makePoisonExplosionAt p w =
|
||||
soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing $
|
||||
foldl' (flip $ makeGasCloud p) w $
|
||||
replicateM 25 (randInCirc 2) & evalState $ _randGen w
|
||||
|
||||
-- just change the number after replicateM to get more or less clouds
|
||||
-- suggested change: use random positions, offset from p, rather than velocities
|
||||
-- so, p +.+ randomOffset
|
||||
-- currently the clouds push away from each other rather hard if they are close
|
||||
|
||||
makeTeslaExplosionAt
|
||||
:: Point2 -- ^ Position
|
||||
-> World
|
||||
-> World
|
||||
makeTeslaExplosionAt ::
|
||||
-- | Position
|
||||
Point2 ->
|
||||
World ->
|
||||
World
|
||||
makeTeslaExplosionAt = undefined
|
||||
|
||||
-- soundOncePos grenadeBang pos $ foldr ($) w listOfFunctions -- a bit shorter
|
||||
-- where
|
||||
-- where
|
||||
-- xs = randomRs (0, 2*pi) $ _randGen w
|
||||
-- j = newProjectileKey w
|
||||
-- pks = [j..]
|
||||
-- listOfFunctions = map
|
||||
-- (\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i))))
|
||||
-- listOfFunctions = map
|
||||
-- (\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i))))
|
||||
-- [1 .. 29]
|
||||
|
||||
makeFlameExplosionAt
|
||||
:: Point2 -- ^ Position
|
||||
-> World
|
||||
-> World
|
||||
makeFlameExplosionAt p w
|
||||
= soundMultiFrom [Explosion 0,Explosion 1] p bangS Nothing w
|
||||
& cWorld . flames .++~ newFlames
|
||||
where
|
||||
|
||||
makeFlameExplosionAt ::
|
||||
-- | Position
|
||||
Point2 ->
|
||||
World ->
|
||||
World
|
||||
makeFlameExplosionAt p w =
|
||||
soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing w
|
||||
& cWorld . flames .++~ newFlames
|
||||
where
|
||||
newFlames = zipWith makeFlameWithVelAndTime velocities timers
|
||||
makeFlameWithVelAndTime vel time = aFlameParticle time p vel
|
||||
velocities = replicateM 15 (randInCirc 1) & evalState $ _randGen w
|
||||
timers = randomRs (80,100) $ _randGen w
|
||||
-- the ( Nthing :: Maybe Int ) here is "maybe" a creature id that the
|
||||
-- particle passes through for the first frame of its existence
|
||||
timers = randomRs (80, 100) $ _randGen w
|
||||
|
||||
-- the ( Nthing :: Maybe Int ) here is "maybe" a creature id that the
|
||||
-- particle passes through for the first frame of its existence
|
||||
|
||||
makeExplosionAt :: Point2 -> World -> World
|
||||
makeExplosionAt p w = w
|
||||
& soundMultiFrom [Explosion 0,Explosion 1] p bangS Nothing
|
||||
& addFlames
|
||||
& cWorld . tempLightSources .:~ theTLS
|
||||
& makeShockwaveAt [] p 50 50 1 white
|
||||
where
|
||||
theTLS = tlsTimeRadColPos 20 150 (V3 1 0.5 0) (addZ 20 p)
|
||||
fVs = replicateM 100 (randInCirc 1) & evalState $ _randGen w
|
||||
makeExplosionAt p w =
|
||||
w
|
||||
& soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing
|
||||
& addFlames
|
||||
& cWorld . tempLightSources .:~ theTLS
|
||||
& makeShockwaveAt [] p 50 50 1 white
|
||||
where
|
||||
theTLS = tlsTimeRadColPos 20 150 (V3 1 0.5 0) (addZ 20 p)
|
||||
fVs = replicateM 100 (randInCirc 1) & evalState $ _randGen w
|
||||
--fPs'' = replicateM 100 (fmap (15 *.*.*) randInHemisphere) & evalState $ _randGen w
|
||||
fPs'' = replicateM 100 (fmap (15 *.*.*) randInHemisphere) & evalState $ _randGen w
|
||||
(fPs',zs) = let (a,b,c) = unzip3 $ map fromV3 fPs''
|
||||
in (zipWith V2 a b, c)
|
||||
(fPs', zs) =
|
||||
let (a, b, c) = unzip3 $ map fromV3 fPs''
|
||||
in (zipWith V2 a b, c)
|
||||
--fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5) fPs'
|
||||
fPs = map (pushAgainstWalls . (+.+) p) fPs'
|
||||
fPs = map (pushAgainstWalls . (+.+) p) fPs'
|
||||
inversePushOut v = (15 - magV v) * 0.01 *.* v
|
||||
fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
|
||||
sizes = randomRs (2,9) $ _randGen w
|
||||
sizes = randomRs (2, 9) $ _randGen w
|
||||
--times = randomRs (20,25) $ _randGen w
|
||||
times = randomRs (15,20) $ _randGen w
|
||||
times = randomRs (15, 20) $ _randGen w
|
||||
mF q z v size time = makeFlamelet q z v size time
|
||||
newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times
|
||||
addFlames w' = foldl' (flip ($)) w' newFs
|
||||
--pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q wls
|
||||
--pushAgainstWalls q = maybe q fst $ reflectPointWalls p q wls
|
||||
pushAgainstWalls q = maybe q fst $ bouncePoint (const True) 1 p q w
|
||||
|
||||
-- wls = wallsNearPoint p w
|
||||
|
||||
@@ -8,42 +8,48 @@ flash : short, abrupt changes in alpha
|
||||
glow : continuous, potentially long, fading, slow changes in alpha
|
||||
flicker : potentially long, moving, abrupt changes in alpha
|
||||
-}
|
||||
module Dodge.WorldEvent.Flash
|
||||
( explosionFlashAt
|
||||
, muzFlareAt
|
||||
, flareCircleAt
|
||||
) where
|
||||
import Dodge.Data
|
||||
module Dodge.WorldEvent.Flash (
|
||||
explosionFlashAt,
|
||||
muzFlareAt,
|
||||
flareCircleAt,
|
||||
) where
|
||||
|
||||
import Dodge.Data.World
|
||||
import Dodge.LightSource
|
||||
--import Dodge.Default
|
||||
import Picture
|
||||
|
||||
import Geometry
|
||||
import LensHelp
|
||||
|
||||
import Picture
|
||||
import System.Random
|
||||
|
||||
muzFlareAt :: Color -> Point3 -> Float -> World -> World
|
||||
muzFlareAt col tranv dir w = w & cWorld . flares .:~ MuzFlare
|
||||
{ _flarePoly = map (rotateV dir)
|
||||
[ V2 0 0
|
||||
, V2 a (-b)
|
||||
, V2 c d
|
||||
]
|
||||
, _flareColor = col
|
||||
, _flareTran3 = tranv
|
||||
, _flareTime = 2
|
||||
}
|
||||
muzFlareAt col tranv dir w =
|
||||
w & cWorld . flares
|
||||
.:~ MuzFlare
|
||||
{ _flarePoly =
|
||||
map
|
||||
(rotateV dir)
|
||||
[ V2 0 0
|
||||
, V2 a (- b)
|
||||
, V2 c d
|
||||
]
|
||||
, _flareColor = col
|
||||
, _flareTran3 = tranv
|
||||
, _flareTime = 2
|
||||
}
|
||||
where
|
||||
(a:b:c:d:_) = randomRs (2,20) (_randGen w)
|
||||
(a : b : c : d : _) = randomRs (2, 20) (_randGen w)
|
||||
|
||||
flareCircleAt :: Color -> Float -> Point3 -> World -> World
|
||||
flareCircleAt col alphax tranv = cWorld . flares .:~ CircFlare
|
||||
{ _flareTime = 2
|
||||
, _flareColor = col
|
||||
, _flareAlpha = alphax
|
||||
, _flareTran3 = tranv
|
||||
}
|
||||
|
||||
flareCircleAt col alphax tranv =
|
||||
cWorld . flares
|
||||
.:~ CircFlare
|
||||
{ _flareTime = 2
|
||||
, _flareColor = col
|
||||
, _flareAlpha = alphax
|
||||
, _flareTran3 = tranv
|
||||
}
|
||||
|
||||
explosionFlashAt :: Point2 -> World -> World
|
||||
explosionFlashAt p = cWorld . tempLightSources .:~ tlsTimeRadFunPos 20 150 (TLSFade 1 10) (addZ 20 p)
|
||||
|
||||
@@ -1,50 +1,62 @@
|
||||
module Dodge.WorldEvent.Shockwave
|
||||
( makeShockwaveAt
|
||||
, inverseShockwaveAt
|
||||
) where
|
||||
import Dodge.Data
|
||||
module Dodge.WorldEvent.Shockwave (
|
||||
makeShockwaveAt,
|
||||
inverseShockwaveAt,
|
||||
) where
|
||||
|
||||
import Dodge.Data.World
|
||||
import Geometry
|
||||
import Picture
|
||||
import LensHelp
|
||||
import Picture
|
||||
|
||||
-- currently very effective against walls
|
||||
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 = cWorld . shockwaves .:~ Shockwave
|
||||
{ _swInvulnerableCrs = is
|
||||
, _swDirection = OutwardShockwave
|
||||
, _swColor = col
|
||||
, _swPos = p
|
||||
, _swRad = rad
|
||||
, _swDam = dam
|
||||
, _swPush = push
|
||||
, _swMaxTime = 10
|
||||
, _swTimer = 10
|
||||
}
|
||||
makeShockwaveAt ::
|
||||
-- | IDs of invulnerable creatures.
|
||||
[Int] ->
|
||||
-- | Center of shockwave.
|
||||
Point2 ->
|
||||
-- | Maximal radius.
|
||||
Float ->
|
||||
-- | Damage caused per frame.
|
||||
Int ->
|
||||
-- | Amount of pushback per frame.
|
||||
Float ->
|
||||
-- | Color of shockwave.
|
||||
Color ->
|
||||
-- | Start world.
|
||||
World ->
|
||||
World
|
||||
makeShockwaveAt is p rad dam push col =
|
||||
cWorld . shockwaves
|
||||
.:~ Shockwave
|
||||
{ _swInvulnerableCrs = is
|
||||
, _swDirection = OutwardShockwave
|
||||
, _swColor = col
|
||||
, _swPos = p
|
||||
, _swRad = rad
|
||||
, _swDam = dam
|
||||
, _swPush = push
|
||||
, _swMaxTime = 10
|
||||
, _swTimer = 10
|
||||
}
|
||||
|
||||
{- Create a shockwave going from an outside circle into a center point. -}
|
||||
inverseShockwaveAt
|
||||
:: Point2 -- Center position
|
||||
-> Float -- Radius
|
||||
-> Int -- Damage
|
||||
-> Float -- Push amount
|
||||
-> World
|
||||
-> World
|
||||
inverseShockwaveAt p rad dam push = cWorld . shockwaves .:~ Shockwave
|
||||
{ _swDirection = InwardShockwave
|
||||
, _swInvulnerableCrs = []
|
||||
, _swColor = cyan
|
||||
, _swPos = p
|
||||
, _swRad = rad
|
||||
, _swDam = dam
|
||||
, _swPush = push
|
||||
, _swMaxTime = 10
|
||||
, _swTimer = 10
|
||||
}
|
||||
inverseShockwaveAt ::
|
||||
Point2 -> -- Center position
|
||||
Float -> -- Radius
|
||||
Int -> -- Damage
|
||||
Float -> -- Push amount
|
||||
World ->
|
||||
World
|
||||
inverseShockwaveAt p rad dam push =
|
||||
cWorld . shockwaves
|
||||
.:~ Shockwave
|
||||
{ _swDirection = InwardShockwave
|
||||
, _swInvulnerableCrs = []
|
||||
, _swColor = cyan
|
||||
, _swPos = p
|
||||
, _swRad = rad
|
||||
, _swDam = dam
|
||||
, _swPush = push
|
||||
, _swMaxTime = 10
|
||||
, _swTimer = 10
|
||||
}
|
||||
|
||||
@@ -1,20 +1,21 @@
|
||||
module Dodge.WorldEvent.Sound
|
||||
( originIDsAt
|
||||
, originsIDsAt
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.SoundLogic
|
||||
import Sound.Data
|
||||
import Geometry.Data
|
||||
import RandomHelp
|
||||
module Dodge.WorldEvent.Sound (
|
||||
originIDsAt,
|
||||
originsIDsAt,
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
import Dodge.Data.World
|
||||
import Dodge.SoundLogic
|
||||
import Geometry.Data
|
||||
import RandomHelp
|
||||
import Sound.Data
|
||||
|
||||
originsIDsAt :: [SoundOrigin] -> [SoundID] -> Point2 -> World -> World
|
||||
originsIDsAt sos sids p w = soundMultiFrom sos p sid Nothing $ set randGen g w
|
||||
where
|
||||
(sid,g) = _randGen w & runState (takeOne sids)
|
||||
(sid, g) = _randGen w & runState (takeOne sids)
|
||||
|
||||
originIDsAt :: SoundOrigin -> [SoundID] -> Point2 -> World -> World
|
||||
originIDsAt so sids p w = soundStart so p sid Nothing $ set randGen g w
|
||||
where
|
||||
(sid,g) = _randGen w & runState (takeOne sids)
|
||||
(sid, g) = _randGen w & runState (takeOne sids)
|
||||
|
||||
@@ -1,15 +1,15 @@
|
||||
{- | Creation of particles in the world. -}
|
||||
module Dodge.WorldEvent.SpawnParticle
|
||||
( makeGasCloud
|
||||
, makeStaticBall
|
||||
, concBall
|
||||
-- , randParticleAt
|
||||
) where
|
||||
import Dodge.Data
|
||||
import RandomHelp
|
||||
import Picture
|
||||
-- | Creation of particles in the world.
|
||||
module Dodge.WorldEvent.SpawnParticle (
|
||||
makeGasCloud,
|
||||
makeStaticBall,
|
||||
concBall,
|
||||
) where
|
||||
|
||||
import Dodge.Data.World
|
||||
import Geometry
|
||||
import LensHelp
|
||||
import Picture
|
||||
import RandomHelp
|
||||
|
||||
--randParticleAt :: (Point2 -> State StdGen Particle) -> Point2 -> World -> World
|
||||
--randParticleAt f p w = w
|
||||
@@ -18,11 +18,12 @@ import LensHelp
|
||||
-- where
|
||||
-- (thepart,g) = runState (f p) (_randGen w)
|
||||
randEnergyBallAt :: (Point2 -> State StdGen EnergyBall) -> Point2 -> World -> World
|
||||
randEnergyBallAt f p w = w
|
||||
& cWorld . energyBalls .:~ thepart
|
||||
& randGen .~ g
|
||||
randEnergyBallAt f p w =
|
||||
w
|
||||
& cWorld . energyBalls .:~ thepart
|
||||
& randGen .~ g
|
||||
where
|
||||
(thepart,g) = runState (f p) (_randGen w)
|
||||
(thepart, g) = runState (f p) (_randGen w)
|
||||
|
||||
makeStaticBall :: Point2 -> World -> World
|
||||
makeStaticBall p = randEnergyBallAt aStaticBall p . (cWorld . posEvents .:~ thesparker)
|
||||
@@ -30,37 +31,41 @@ makeStaticBall p = randEnergyBallAt aStaticBall p . (cWorld . posEvents .:~ thes
|
||||
thesparker = PosEvent SparkSpawner 10 p
|
||||
|
||||
concBall :: Point2 -> Shockwave
|
||||
concBall p = Shockwave
|
||||
{ _swDirection = OutwardShockwave
|
||||
, _swInvulnerableCrs = []
|
||||
, _swColor = white
|
||||
, _swPos = p
|
||||
, _swRad = 15
|
||||
, _swDam = 4
|
||||
, _swPush = 1
|
||||
, _swMaxTime = 10
|
||||
, _swTimer = 10
|
||||
}
|
||||
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
|
||||
aStaticBall p = return EnergyBall
|
||||
{ _ebVel = 0
|
||||
, _ebColor = blue
|
||||
, _ebPos = p
|
||||
, _ebWidth = 3
|
||||
, _ebTimer = 20
|
||||
, _ebEff = (ELECTRICAL,1)
|
||||
, _ebZ = 20
|
||||
, _ebRot = 0
|
||||
}
|
||||
aStaticBall p =
|
||||
return
|
||||
EnergyBall
|
||||
{ _ebVel = 0
|
||||
, _ebColor = blue
|
||||
, _ebPos = p
|
||||
, _ebWidth = 3
|
||||
, _ebTimer = 20
|
||||
, _ebEff = (ELECTRICAL, 1)
|
||||
, _ebZ = 20
|
||||
, _ebRot = 0
|
||||
}
|
||||
|
||||
-- | Note damgeInRadius by itself never destroys the particle
|
||||
--damageInRadius :: Float -> Particle -> World -> World
|
||||
--damageInRadius size pt = damageInArea isClose closeWls pt
|
||||
-- where
|
||||
-- p = _ptPos pt
|
||||
-- closeWls wl = uncurry segOnCirc (_wlLine wl) p size
|
||||
-- isClose cr = dist p (_crPos cr) < _crRad cr + size
|
||||
{- | Note damgeInRadius by itself never destroys the particle
|
||||
damageInRadius :: Float -> Particle -> World -> World
|
||||
damageInRadius size pt = damageInArea isClose closeWls pt
|
||||
where
|
||||
p = _ptPos pt
|
||||
closeWls wl = uncurry segOnCirc (_wlLine wl) p size
|
||||
isClose cr = dist p (_crPos cr) < _crRad cr + size
|
||||
-}
|
||||
|
||||
--damageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Particle -> World -> World
|
||||
--{-# INLINE damageInArea #-}
|
||||
@@ -69,46 +74,50 @@ aStaticBall p = return EnergyBall
|
||||
-- p = _ptPos pt
|
||||
-- damcrs = foldl' (flip $ \cr -> fst . hiteff (S.yield (p,Left cr))) w $ IM.filter crt $ _creatures w
|
||||
-- damwls w' = runIdentity
|
||||
-- . S.fold_
|
||||
-- (flip $ \wl -> fst . hiteff (S.yield (p,Right wl)))
|
||||
-- w'
|
||||
-- . S.fold_
|
||||
-- (flip $ \wl -> fst . hiteff (S.yield (p,Right wl)))
|
||||
-- w'
|
||||
-- id
|
||||
-- . S.filter wlt
|
||||
-- $ wlsNearPoint p w'
|
||||
-- hiteff = _ptHitEff pt pt
|
||||
|
||||
-- | At writing the radius is half the size of the effect area
|
||||
makeGasCloud
|
||||
:: Point2 -- ^ Position
|
||||
-> Point2 -- ^ Velocity
|
||||
-> World
|
||||
-> World
|
||||
makeGasCloud pos vel w = w
|
||||
& cWorld . clouds .:~ theCloud
|
||||
& randGen .~ g
|
||||
where
|
||||
theCloud = Cloud
|
||||
{ _clPos = addZ 20 pos
|
||||
, _clVel = addZ 0 vel
|
||||
, _clPict = DrawGasCloud col
|
||||
, _clRad = 10
|
||||
, _clAlt = 25
|
||||
, _clTimer = 400
|
||||
, _clType = GasCloud
|
||||
}
|
||||
(col, g) = runState (takeOne [green,yellow]) $ _randGen w
|
||||
{- Attach poison cloud damage to creatures near cloud. -}
|
||||
makeGasCloud ::
|
||||
-- | Position
|
||||
Point2 ->
|
||||
-- | Velocity
|
||||
Point2 ->
|
||||
World ->
|
||||
World
|
||||
makeGasCloud pos vel w =
|
||||
w
|
||||
& cWorld . clouds .:~ theCloud
|
||||
& randGen .~ g
|
||||
where
|
||||
theCloud =
|
||||
Cloud
|
||||
{ _clPos = addZ 20 pos
|
||||
, _clVel = addZ 0 vel
|
||||
, _clPict = DrawGasCloud col
|
||||
, _clRad = 10
|
||||
, _clAlt = 25
|
||||
, _clTimer = 400
|
||||
, _clType = GasCloud
|
||||
}
|
||||
(col, g) = runState (takeOne [green, yellow]) $ _randGen w
|
||||
|
||||
{- Attach poison cloud damage to creatures near cloud. -}
|
||||
|
||||
{- Update of a flamelet.
|
||||
Applies movement and attaches damage to nearby creatures. -}
|
||||
-- This should be unified in many ways with moveFlame
|
||||
--moveFlamelet :: World -> Particle -> (World, Maybe Particle)
|
||||
--moveFlamelet w pt
|
||||
--moveFlamelet w pt
|
||||
-- | _ptTimer pt <= 0 = ( w, Nothing)
|
||||
-- | otherwise = (ptFlicker pt $ damageInRadius 5 mvPt' w, Just mvPt')
|
||||
-- where
|
||||
-- mvPt' = pt
|
||||
-- where
|
||||
-- mvPt' = pt
|
||||
-- & ptTimer -~ 1
|
||||
-- & ptPos .~ _ptPos pt +.+ _ptVel pt
|
||||
-- & ptVel .*.*~ 0.8
|
||||
|
||||
@@ -1,66 +1,77 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
{- |
|
||||
Find which objects lie upon a line.
|
||||
-}
|
||||
module Dodge.WorldEvent.ThingsHit
|
||||
( thingsHit
|
||||
, thingHit
|
||||
, thingHitFilt
|
||||
, thingsHitExceptCr
|
||||
, crsHitRadial
|
||||
, wlsHitRadial
|
||||
)
|
||||
where
|
||||
import Dodge.Zoning.Wall
|
||||
import Dodge.Zoning.Creature
|
||||
import Dodge.Data
|
||||
-}
|
||||
module Dodge.WorldEvent.ThingsHit (
|
||||
thingsHit,
|
||||
thingHit,
|
||||
thingHitFilt,
|
||||
thingsHitExceptCr,
|
||||
crsHitRadial,
|
||||
wlsHitRadial,
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
import Data.Bifunctor
|
||||
import qualified Data.IntSet as IS
|
||||
import Data.List (sortOn)
|
||||
import Data.Maybe
|
||||
import Dodge.Base
|
||||
import Dodge.Data.World
|
||||
import Dodge.Zoning.Creature
|
||||
import Dodge.Zoning.Wall
|
||||
import Geometry
|
||||
import qualified ListHelp as List
|
||||
|
||||
import Control.Lens
|
||||
import Data.Maybe
|
||||
import Data.List (sortOn)
|
||||
import Data.Bifunctor
|
||||
import qualified Data.IntSet as IS
|
||||
|
||||
{- List those objects that appear on a line. -}
|
||||
thingsHit
|
||||
:: Point2 -- ^ Line start point
|
||||
-> Point2 -- ^ Line end point
|
||||
-> World
|
||||
-> [(Point2, Either Creature Wall)]
|
||||
thingsHit sp ep w = List.mergeOn (dist sp . fst)
|
||||
(map (second Left) (crsHit sp ep w))
|
||||
(map (second Right) (wlsHit sp ep w))
|
||||
thingsHit ::
|
||||
-- | Line start point
|
||||
Point2 ->
|
||||
-- | Line end point
|
||||
Point2 ->
|
||||
World ->
|
||||
[(Point2, Either Creature Wall)]
|
||||
thingsHit sp ep w =
|
||||
List.mergeOn
|
||||
(dist sp . fst)
|
||||
(map (second Left) (crsHit sp ep w))
|
||||
(map (second Right) (wlsHit sp ep w))
|
||||
|
||||
--{- List those objects that appear on a line. -}
|
||||
--thingsHit
|
||||
-- :: Point2 -- ^ Line start point
|
||||
-- -> Point2 -- ^ Line end point
|
||||
-- -> World
|
||||
-- -> World
|
||||
-- -> StreamOf (Point2, Either Creature Wall)
|
||||
--thingsHit sp ep w = void $ S.mergeOn (dist sp . fst)
|
||||
--thingsHit sp ep w = void $ S.mergeOn (dist sp . fst)
|
||||
-- (S.map (second Left) (S.each $ crsHit sp ep w))
|
||||
-- (S.map (second Right) (wlsHit sp ep w))
|
||||
|
||||
crsHit :: Point2 -> Point2 -> World -> [(Point2, Creature)]
|
||||
crsHit sp ep w
|
||||
| sp == ep = mempty
|
||||
| otherwise = sortOn (dist sp . fst)
|
||||
. overlap1SegCrs sp ep
|
||||
. mapMaybe (\cid -> w ^? cWorld . creatures . ix cid)
|
||||
. IS.toList
|
||||
. crsNearSeg sp ep
|
||||
$ w
|
||||
| sp == ep = mempty
|
||||
| otherwise =
|
||||
sortOn (dist sp . fst)
|
||||
. overlap1SegCrs sp ep
|
||||
. mapMaybe (\cid -> w ^? cWorld . creatures . ix cid)
|
||||
. IS.toList
|
||||
. crsNearSeg sp ep
|
||||
$ w
|
||||
|
||||
thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool)
|
||||
-> Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
|
||||
thingHitFilt ::
|
||||
(Creature -> Bool) ->
|
||||
(Wall -> Bool) ->
|
||||
Point2 ->
|
||||
Point2 ->
|
||||
World ->
|
||||
Maybe (Point2, Either Creature Wall)
|
||||
thingHitFilt fcr fwl sp ep = List.find (f . snd) . thingsHit sp ep
|
||||
where
|
||||
f (Left cr) = fcr cr
|
||||
f (Right wl) = fwl wl
|
||||
|
||||
--thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool)
|
||||
--thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool)
|
||||
-- -> Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
|
||||
--thingHitFilt fcr fwl sp ep = runIdentity . S.head_ . S.filter (f . snd) . thingsHit sp ep
|
||||
-- where
|
||||
@@ -72,37 +83,43 @@ thingHit sp ep = listToMaybe . thingsHit sp ep
|
||||
|
||||
{- List objects that appear on a line.
|
||||
Can filter out a creature. -}
|
||||
thingsHitExceptCr
|
||||
:: Maybe Int -- ^ A possible creature ID
|
||||
-> Point2 -- ^ Line start point
|
||||
-> Point2 -- ^ Line end point
|
||||
-> World
|
||||
-> [(Point2, Either Creature Wall)]
|
||||
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
|
||||
thingsHitExceptCr ::
|
||||
-- | A possible creature ID
|
||||
Maybe Int ->
|
||||
-- | Line start point
|
||||
Point2 ->
|
||||
-- | Line end point
|
||||
Point2 ->
|
||||
World ->
|
||||
[(Point2, Either Creature Wall)]
|
||||
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
|
||||
thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
|
||||
where
|
||||
crNotCid (_,Left cr) = _crID cr /= cid
|
||||
where
|
||||
crNotCid (_, Left cr) = _crID cr /= cid
|
||||
crNotCid _ = True
|
||||
|
||||
--{- List objects that appear on a line.
|
||||
--Can filter out a creature. -}
|
||||
--thingsHitExceptCr
|
||||
--thingsHitExceptCr
|
||||
-- :: Maybe Int -- ^ A possible creature ID
|
||||
-- -> Point2 -- ^ Line start point
|
||||
-- -> Point2 -- ^ Line end point
|
||||
-- -> World
|
||||
-- -> World
|
||||
-- -> StreamOf (Point2, Either Creature Wall)
|
||||
--thingsHitExceptCr Nothing sp ep = thingsHit sp ep
|
||||
--thingsHitExceptCr (Just cid) sp ep = S.filter crNotCid . thingsHit sp ep
|
||||
-- where
|
||||
-- where
|
||||
-- crNotCid (_,Left cr) = _crID cr /= cid
|
||||
-- crNotCid _ = True
|
||||
|
||||
wlsHit :: Point2 -> Point2 -> World -> [(Point2, Wall)]
|
||||
wlsHit sp ep
|
||||
| sp == ep = const mempty
|
||||
| otherwise = sortOn (dist sp . fst)
|
||||
. overlapSegWalls sp ep
|
||||
. wlsNearSeg sp ep
|
||||
| sp == ep = const mempty
|
||||
| otherwise =
|
||||
sortOn (dist sp . fst)
|
||||
. overlapSegWalls sp ep
|
||||
. wlsNearSeg sp ep
|
||||
|
||||
--wlsHit :: Point2 -> Point2 -> World -> StreamOf (Point2, Wall)
|
||||
--wlsHit sp ep
|
||||
-- | sp == ep = const mempty
|
||||
@@ -116,6 +133,7 @@ wlsHitRadial p r = mapMaybe f . wlsNearCirc p r
|
||||
f wl = uncurry (intersectSegSeg p (p -.- r *.* v)) (_wlLine wl) <&> (,wl)
|
||||
where
|
||||
v = normalizeV $ vNormal $ uncurry (-.-) $ _wlLine wl
|
||||
|
||||
--wlsHitRadial :: Point2 -> Float -> World -> StreamOf (Point2, Wall)
|
||||
--wlsHitRadial p r = S.mapMaybe f . wlsInsideCirc p r
|
||||
-- where
|
||||
@@ -126,7 +144,7 @@ wlsHitRadial p r = mapMaybe f . wlsNearCirc p r
|
||||
crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)]
|
||||
crsHitRadial p r = mapMaybe f . crsNearCirc p r
|
||||
where
|
||||
f cr
|
||||
f cr
|
||||
| dist cpos p <= r = Just (cpos +.+ r *.* normalizeV (p -.- cpos), cr)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
|
||||
Reference in New Issue
Block a user