Hlinting
This commit is contained in:
@@ -1,3 +1,6 @@
|
||||
{-
|
||||
Bullet update.
|
||||
-}
|
||||
module Dodge.WorldEvent.Bullet
|
||||
where
|
||||
import Dodge.Data
|
||||
@@ -16,7 +19,10 @@ import Data.Function (on)
|
||||
import Data.Bifunctor
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
|
||||
mvGenBullet' :: World -> Particle' -> (World, Maybe Particle')
|
||||
{-
|
||||
Update for a generic bullet.
|
||||
-}
|
||||
mvGenBullet' :: World -> Particle -> (World, Maybe Particle)
|
||||
mvGenBullet' w bt
|
||||
| t <= 0 = (w, Nothing)
|
||||
| t < 4 = (w, Just $ set btPassThrough' Nothing
|
||||
|
||||
@@ -1,3 +1,6 @@
|
||||
{-
|
||||
Explosions: creation of shockwave and particles at a given point.
|
||||
-}
|
||||
module Dodge.WorldEvent.Explosion
|
||||
where
|
||||
|
||||
@@ -18,20 +21,24 @@ import System.Random
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Control.Lens
|
||||
|
||||
-- The following should be improved.... I've made a first pass
|
||||
makePoisonExplosionAt :: Point2 -> World -> World
|
||||
makePoisonExplosionAt
|
||||
:: Point2 -- ^ Position
|
||||
-> World
|
||||
-> World
|
||||
makePoisonExplosionAt p w = soundOncePos grenadeBang p $ foldr (makeGasCloud p) w vels
|
||||
where
|
||||
vels = evalState (sequence ( replicate 25 (randInCirc 2) )) (_randGen w)
|
||||
-- just change the number after replicate to get more or less clouds
|
||||
vels = 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 -> World -> World
|
||||
makeTeslaExplosionAt
|
||||
:: Point2 -- ^ Position
|
||||
-> World
|
||||
-> World
|
||||
makeTeslaExplosionAt pos w = soundOncePos grenadeBang pos $ foldr ($) w listOfFunctions -- a bit shorter
|
||||
where
|
||||
-- rad or 360? Radians (hopefully) everywhere
|
||||
xs = randomRs (0, 2*pi) $ _randGen w
|
||||
j = newProjectileKey w
|
||||
pks = [j..]
|
||||
@@ -39,31 +46,32 @@ makeTeslaExplosionAt pos w = soundOncePos grenadeBang pos $ foldr ($) w listOfFu
|
||||
(\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i))))
|
||||
[1 .. 29]
|
||||
|
||||
-- slightly more work done on this one, want the flames to last for different
|
||||
-- times
|
||||
-- the new flames are directly added to the list of particles
|
||||
makeFlameExplosionAt :: Point2 -> World -> World
|
||||
makeFlameExplosionAt p w = soundOncePos grenadeBang p $ over particles' (newFlames ++ ) w
|
||||
makeFlameExplosionAt
|
||||
:: Point2 -- ^ Position
|
||||
-> World
|
||||
-> World
|
||||
makeFlameExplosionAt p w = soundOncePos grenadeBang p $ over particles (newFlames ++ ) w
|
||||
where
|
||||
newFlames = zipWith makeFlameWithVelAndTime velocities timers
|
||||
makeFlameWithVelAndTime vel time = aFlameParticle time p vel Nothing
|
||||
velocities = evalState (sequence ( replicate 15 (randInCirc 1) )) (_randGen w)
|
||||
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
|
||||
|
||||
|
||||
makeExplosionAt :: Point2 -> World -> World
|
||||
makeExplosionAt
|
||||
:: Point2 -- ^ Position
|
||||
-> World
|
||||
-> World
|
||||
makeExplosionAt p w = soundOncePos grenadeBang p
|
||||
. addFlames
|
||||
. explosionFlashAt p
|
||||
$ makeShockwaveAt [] p 50 10 1 white
|
||||
w
|
||||
where
|
||||
fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w
|
||||
fPs' = evalState ((sequence . take 75 . repeat . randInCirc) 15) $ _randGen w
|
||||
fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5)
|
||||
fPs'
|
||||
fVs = replicateM 75 (randInCirc 1) & evalState $ _randGen w
|
||||
fPs' = replicateM 75 (randInCirc 15) & evalState $ _randGen w
|
||||
fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5) fPs'
|
||||
inversePushOut v = (15 - magV v) * 0.01 *.* v
|
||||
fVs' = zipWith (+.+) fVs $ map inversePushOut fPs'
|
||||
sizes = randomRs (2,6) $ _randGen w
|
||||
@@ -71,6 +79,6 @@ makeExplosionAt p w = soundOncePos grenadeBang p
|
||||
mF q v size time = makeFlameletTimed q v Nothing size time
|
||||
newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times
|
||||
addFlames w = foldr ($) w newFs
|
||||
pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y)
|
||||
pushAgainstWalls q = maybe q (uncurry (+.+))
|
||||
$ collidePointWalls p q $ wallsNearPoint q w
|
||||
|
||||
|
||||
@@ -1,3 +1,13 @@
|
||||
{- | Flashes.
|
||||
projected naming conventions: three base types of light:
|
||||
glare : "low lighting", draws lines around creatures and walls
|
||||
flare : coloured light drawn on top of picture in fixed shapes
|
||||
light : removal of shadows
|
||||
duration (subject to modification):
|
||||
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
|
||||
where
|
||||
import Dodge.Data
|
||||
@@ -13,71 +23,67 @@ import Geometry
|
||||
import Data.Maybe (maybeToList)
|
||||
|
||||
import Control.Lens
|
||||
-- projected naming: three base types of light:
|
||||
-- glare : "low lighting", draws lines around creatures and walls
|
||||
-- flare : coloured light drawn on top of picture in fixed shapes
|
||||
-- light : removal of shadows
|
||||
-- duration (subject to modification):
|
||||
-- flash : short, abrupt changes in alpha
|
||||
-- glow : continuous, potentially long, fading, slow changes in alpha
|
||||
-- flicker : potentially long, moving, abrupt changes in alpha
|
||||
|
||||
glareAt :: Int -> Float -> Float -> Color -> Int -> Float -> Point2 -> World -> World
|
||||
glareAt t len wdth col nrays rad p w = foldr (glareLine' t len wdth col p) w ps
|
||||
where ps = map ((+.+) p) $ nRaysRad nrays rad
|
||||
where
|
||||
ps = map (p +.+) $ nRaysRad nrays rad
|
||||
|
||||
{- White flash. -}
|
||||
sparkFlashAt :: Point2 -> World -> World
|
||||
sparkFlashAt p =
|
||||
glareAt 2 10 5 (withAlpha 0.05 white) 20 30 p
|
||||
sparkFlashAt =
|
||||
glareAt 2 10 5 (withAlpha 0.05 white) 20 30
|
||||
|
||||
{- Red flash. -}
|
||||
bloodFlashAt :: Point2 -> World -> World
|
||||
bloodFlashAt p =
|
||||
over particles' ((:) (flashFlareAt red 0.4 p))
|
||||
. glareAt 2 10 5 (withAlpha 0.05 red) 20 30 p
|
||||
over particles (flashFlareAt red 0.4 p : )
|
||||
. glareAt 2 10 5 (withAlpha 0.05 red) 20 30 p
|
||||
|
||||
{- Cyan flash. -}
|
||||
teslaGunFlashAt :: Point2 -> World -> World
|
||||
teslaGunFlashAt p =
|
||||
over particles' ((:) (flashFlareAt cyan 0.3 p))
|
||||
. glareAt 2 10 5 (withAlpha 0.1 cyan) 20 30 p
|
||||
teslaGunFlashAt p =
|
||||
over particles (flashFlareAt cyan 0.3 p : )
|
||||
. glareAt 2 10 5 (withAlpha 0.1 cyan) 20 30 p
|
||||
|
||||
{- Yellow flash. -}
|
||||
laserGunFlashAt :: Point2 -> World -> World
|
||||
laserGunFlashAt p =
|
||||
over particles' ((:) (flashFlareAt yellow 0.2 p))
|
||||
. glareAt 2 10 5 (withAlpha 0.05 yellow) 20 30 p
|
||||
over particles (flashFlareAt yellow 0.2 p : )
|
||||
. glareAt 2 10 5 (withAlpha 0.05 yellow) 20 30 p
|
||||
|
||||
glareLine' :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> World
|
||||
glareLine' t len wdth col a b w = w & particles' %~ (maybeToList linePt ++)
|
||||
where linePt :: Maybe Particle'
|
||||
linePt = glareBetween t len wdth col a b w
|
||||
glareLine' t len wdth col a b w = w & particles %~ (maybeToList linePt ++)
|
||||
where
|
||||
linePt :: Maybe Particle
|
||||
linePt = glareBetween t len wdth col a b w
|
||||
|
||||
glareBetween :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> Maybe Particle'
|
||||
glareBetween :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> Maybe Particle
|
||||
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')
|
||||
}
|
||||
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')
|
||||
}
|
||||
|
||||
lowLightPic :: Float -> Float -> Color -> (Point2, Point2) -> World -> Picture
|
||||
lowLightPic len wdth col (a,b) w
|
||||
= case thingsHit a b w of
|
||||
lowLightPic len wdth col (a,b) w = case thingsHit a b w of
|
||||
((p, E3x2 wall):_)
|
||||
-> setCol . lineOfThickness wdth $ [alongSegBy len p wa, alongSegBy len p wb]
|
||||
where x = len *.* (normalizeV $ wa -.- wb)
|
||||
where x = len *.* normalizeV (wa -.- wb)
|
||||
(wa:wb:_) = _wlLine wall
|
||||
((p, E3x1 cr):_)
|
||||
-> setCol . uncurry translate cp . rotate (-0.25 * pi + argV (p -.- cp))
|
||||
$ thickArc 0 (pi/2) (_crRad cr) wdth
|
||||
where cp = _crPos cr
|
||||
_ -> blank
|
||||
where setCol = color col . setDepth (-0.5) . setLayer 2
|
||||
where setCol = color col . setDepth (-0.5) . setLayer 2
|
||||
|
||||
flashFlareAt :: Color -> Float -> Point2 -> Particle'
|
||||
flashFlareAt col alphax (x,y) =
|
||||
Particle'
|
||||
{ _ptDraw = const $ setLayer 2 . setDepth (-0.9) . translate x y
|
||||
$ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
|
||||
, _ptUpdate' = ptTimer' 1
|
||||
}
|
||||
flashFlareAt :: Color -> Float -> Point2 -> Particle
|
||||
flashFlareAt col alphax (x,y) = Particle
|
||||
{ _ptDraw = const $ setLayer 2 . setDepth (-0.9) . translate x y
|
||||
$ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
|
||||
, _ptUpdate' = ptTimer' 1
|
||||
}
|
||||
|
||||
explosionFlashAt :: Point2 -> World -> World
|
||||
explosionFlashAt p = over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p)
|
||||
@@ -94,19 +100,18 @@ lowLightDirected col a b angles w
|
||||
|
||||
|
||||
muzzleFlashAt :: Point2 -> World -> World
|
||||
muzzleFlashAt p = over particles' ((:) (muzzleFlashPt p))
|
||||
muzzleFlashAt p = over particles (muzzleFlashPt p : )
|
||||
. glareAt 2 10 5 (withAlpha 0.5 white) 20 30 p
|
||||
|
||||
muzzleFlashPt :: Point2 -> Particle'
|
||||
muzzleFlashPt (x,y) =
|
||||
Particle'
|
||||
{ _ptDraw = const $ setDepth 0
|
||||
. setLayer 2
|
||||
. translate x y
|
||||
$ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
|
||||
, _ptUpdate' = ptTimer' 1
|
||||
}
|
||||
muzzleFlashPt :: Point2 -> Particle
|
||||
muzzleFlashPt (x,y) = Particle
|
||||
{ _ptDraw = const $ setDepth 0
|
||||
. setLayer 2
|
||||
. translate x y
|
||||
$ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
|
||||
, _ptUpdate' = ptTimer' 1
|
||||
}
|
||||
|
||||
laserScopeTargetGlow :: Color -> Point2 -> World -> World
|
||||
laserScopeTargetGlow col p = glareAt 2 3 1 (withAlpha 0.1 col) 15 5 p
|
||||
laserScopeTargetGlow col = glareAt 2 3 1 (withAlpha 0.1 col) 15 5
|
||||
|
||||
|
||||
@@ -1,8 +1,14 @@
|
||||
{-
|
||||
Helper functions for particles.
|
||||
-}
|
||||
module Dodge.WorldEvent.HelperParticle
|
||||
where
|
||||
|
||||
import Dodge.Data
|
||||
|
||||
ptTimer' :: Int -> World -> Particle' -> (World, Maybe Particle')
|
||||
{-
|
||||
A simple timer update for particles.
|
||||
-}
|
||||
ptTimer' :: Int -> World -> Particle -> (World, Maybe Particle)
|
||||
ptTimer' 0 w pt = (w, Nothing)
|
||||
ptTimer' n w pt = (w, Just $ pt {_ptUpdate' = ptTimer' (n-1)})
|
||||
|
||||
@@ -9,12 +9,12 @@ import Data.Maybe
|
||||
|
||||
import Control.Lens
|
||||
|
||||
type HitCreatureEffect = Particle' -> Point2 -> Creature -> World -> World
|
||||
type HitWallEffect = Particle' -> Point2 -> Wall -> World -> World
|
||||
type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World
|
||||
type HitCreatureEffect = Particle -> Point2 -> Creature -> World -> World
|
||||
type HitWallEffect = Particle -> Point2 -> Wall -> World -> World
|
||||
type HitForceFieldEffect = Particle -> Point2 -> ForceField -> World -> World
|
||||
|
||||
passThroughAll :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
|
||||
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
|
||||
Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle)
|
||||
passThroughAll crEff wlEff ffEff pt hitThings w = (w, mvPt)
|
||||
where
|
||||
mvPt = Just $ pt & btTrail' .~ (newP : trl)
|
||||
@@ -24,7 +24,7 @@ passThroughAll crEff wlEff ffEff pt hitThings w = (w, mvPt)
|
||||
newP = head trl +.+ _btVel' pt
|
||||
|
||||
destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
|
||||
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
|
||||
Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle)
|
||||
destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
|
||||
[] -> ( w, mvPt)
|
||||
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
|
||||
@@ -40,7 +40,7 @@ destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
|
||||
newP = head trl +.+ _btVel' pt
|
||||
|
||||
penWalls :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
|
||||
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
|
||||
Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle)
|
||||
penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
|
||||
[] -> ( w, mvPt)
|
||||
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
|
||||
@@ -57,7 +57,7 @@ penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
|
||||
wth = _btWidth' pt
|
||||
newP = head trl +.+ _btVel' pt
|
||||
|
||||
doFlameDam :: Int -> Particle' -> Point2 -> Creature -> World -> World
|
||||
doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World
|
||||
doFlameDam amount pt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
|
||||
((:) $ Flaming amount sp p ep)
|
||||
where sp = _btPos' pt
|
||||
|
||||
@@ -20,16 +20,17 @@ makeShockwaveAt
|
||||
-> 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
|
||||
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'
|
||||
-> Point2 -> Float -> Int -> Float -> Color -> Int -> Particle
|
||||
shockwaveAt is p rad dam push col maxtime
|
||||
= Shockwave'
|
||||
{ _ptDraw = drawShockwave
|
||||
, _ptUpdate' = mvShockwave' is
|
||||
, _ptUpdate' = mvShockwave is
|
||||
, _btColor' = col
|
||||
, _btPos' = p
|
||||
, _btRad' = rad
|
||||
@@ -39,7 +40,10 @@ shockwaveAt is p rad dam push col maxtime
|
||||
, _btTimer' = maxtime
|
||||
}
|
||||
|
||||
drawShockwave :: Particle' -> Picture
|
||||
{-
|
||||
Shockwave picture.
|
||||
-}
|
||||
drawShockwave :: Particle -> Picture
|
||||
drawShockwave pt = pic
|
||||
where
|
||||
pic = onLayer PtLayer $ uncurry translate p
|
||||
@@ -51,10 +55,10 @@ drawShockwave pt = pic
|
||||
tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
|
||||
t = _btTimer' pt
|
||||
|
||||
mvShockwave'
|
||||
mvShockwave
|
||||
:: [Int] -- ^ IDs of invulnerable creatures.
|
||||
-> World -> Particle' -> (World, Maybe Particle')
|
||||
mvShockwave' is w pt
|
||||
-> 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)
|
||||
@@ -83,32 +87,51 @@ mvShockwave' is w pt
|
||||
|
||||
-------------------------------------------------
|
||||
|
||||
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')
|
||||
{-
|
||||
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 dam push pushexp = over particles (theShockwave :)
|
||||
where
|
||||
theShockwave = Particle
|
||||
{ _ptDraw = const blank
|
||||
, _ptUpdate' = moveInverseShockWave 10 p rad push pushexp
|
||||
}
|
||||
moveInverseShockWave
|
||||
:: Int -- ^ Timer
|
||||
-> Point2 -- ^ Center position
|
||||
-> Float -- ^ Radius
|
||||
-> Float -- ^ Push amount
|
||||
-> Float -- ^ Push amount parameter
|
||||
-> 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
|
||||
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
|
||||
|
||||
@@ -1,3 +1,6 @@
|
||||
{-
|
||||
Creation of particles in the world.
|
||||
-}
|
||||
module Dodge.WorldEvent.SpawnParticle
|
||||
where
|
||||
import Dodge.Data
|
||||
@@ -11,7 +14,6 @@ import Dodge.WorldEvent.Bullet
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.RandomHelp
|
||||
import Dodge.Debug
|
||||
|
||||
import Picture
|
||||
import Geometry
|
||||
|
||||
@@ -23,8 +25,12 @@ import Data.Function (on)
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
|
||||
-- take out the flame particle from makeFlame
|
||||
aFlameParticle :: Int -> Point2 -> Point2 -> Maybe Int -> Particle'
|
||||
aFlameParticle
|
||||
:: Int -- ^ Timer
|
||||
-> Point2 -- ^ Position
|
||||
-> Point2 -- ^ Velocity
|
||||
-> Maybe Int -- ^ Creature id
|
||||
-> Particle
|
||||
aFlameParticle t pos vel maycid = Pt'
|
||||
{ _ptDraw = drawFlame vel
|
||||
, _ptUpdate' = moveFlame vel
|
||||
@@ -37,10 +43,18 @@ aFlameParticle t pos vel maycid = Pt'
|
||||
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
|
||||
}
|
||||
|
||||
makeFlame :: Int -> Point2 -> Point2 -> Maybe Int -> World -> World
|
||||
makeFlame t pos vel maycid = over particles' (aFlameParticle t pos vel maycid : )
|
||||
makeFlame
|
||||
:: Int -- ^ Timer
|
||||
-> Point2 -- ^ Position
|
||||
-> Point2 -- ^ Velocity
|
||||
-> Maybe Int -- ^ Creature id
|
||||
-> World
|
||||
-> World
|
||||
makeFlame t pos vel maycid = over particles (aFlameParticle t pos vel maycid : )
|
||||
|
||||
drawFlame :: Point2 -> Particle' -> Picture
|
||||
drawFlame
|
||||
:: Point2 -- ^ Rotate direction
|
||||
-> Particle -> Picture
|
||||
drawFlame rotd pt = thePic
|
||||
where
|
||||
ep = _btPos' pt
|
||||
@@ -69,13 +83,20 @@ drawFlame rotd pt = thePic
|
||||
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (0,1)
|
||||
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2)
|
||||
|
||||
moveFlame :: Point2 -> World -> Particle' -> (World, Maybe Particle')
|
||||
{-
|
||||
TODO: add generalised area damage particles/hiteffects.
|
||||
-}
|
||||
moveFlame
|
||||
:: Point2 -- ^ Rotation direction
|
||||
-> World
|
||||
-> Particle
|
||||
-> (World, Maybe Particle)
|
||||
moveFlame rotd w pt
|
||||
| time <= 0 = (smokeGen w, Nothing)
|
||||
| otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
|
||||
((p,(E3x1 cr)):_) -> (soundAndGlare damcrs , mvPt')
|
||||
(thing@(p,(E3x2 wl)):_) -> (fst $ hiteff [thing] damcrs , rfl wl p)
|
||||
_ -> (soundAndGlare damcrs , mvPt)
|
||||
((p,E3x1 cr):_) -> (soundAndGlare damcrs , mvPt')
|
||||
(thing@(p,E3x2 wl):_) -> (fst $ hiteff [thing] damcrs , rfl wl p)
|
||||
_ -> (soundAndGlare damcrs , mvPt)
|
||||
where
|
||||
time = _btTimer' pt
|
||||
soundAndGlare = soundFrom Flame fireSound 2 500
|
||||
@@ -89,16 +110,19 @@ moveFlame rotd w pt
|
||||
mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep
|
||||
, _btPassThrough' = Nothing
|
||||
,_btVel' = 0.7 *.* vel}
|
||||
damcrs = foldr ($) w $ map (\cr -> fst . hiteff [(ep,E3x1 cr)]) $ filter closeCrs
|
||||
$ IM.elems $ _creatures w
|
||||
damcrs = foldr (\cr -> fst . hiteff [(ep,E3x1 cr)]) w
|
||||
$ filter closeCrs
|
||||
$ IM.elems $ _creatures w
|
||||
closeCrs cr = dist ep (_crPos cr)
|
||||
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
|
||||
+ 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
|
||||
angleCoeff x = abs $ 1 - (abs $ (x * 2 - pi) / (pi))
|
||||
angleCoeff x = abs $ 1 - abs ( (x * 2 - pi) / pi )
|
||||
hiteff = _btHitEffect' pt pt
|
||||
rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p
|
||||
, _btVel' = reflV wl--, _ptDraw = const $ thepic $ pOut p
|
||||
}
|
||||
rfl wl p = Just $ pt
|
||||
{ _btTimer' = time -1
|
||||
, _btPos' = pOut p
|
||||
, _btVel' = reflV wl
|
||||
}
|
||||
pOut p = p +.+ safeNormalizeV (sp -.- p)
|
||||
reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
||||
vel )
|
||||
@@ -106,23 +130,35 @@ moveFlame rotd w pt
|
||||
(0.2 *.* vel)
|
||||
smokeGen = makeFlamerSmokeAt ep
|
||||
|
||||
makeFlameletTimed :: Point2 -> Point2 -> Maybe Int -> Float -> Int -> World -> World
|
||||
makeFlameletTimed pos vel maycid size time w
|
||||
= set randGen g $ over particles' ((:) theFlamelet) w
|
||||
where theFlamelet =
|
||||
Pt' { _ptDraw = drawFlamelet rot
|
||||
, _ptUpdate' = moveFlamelet
|
||||
, _btVel' = vel
|
||||
, _btColor' = red
|
||||
, _btPos' = pos
|
||||
, _btPassThrough' = maycid
|
||||
, _btWidth' = size
|
||||
, _btTimer' = time
|
||||
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
|
||||
}
|
||||
(rot ,g) = randomR (0,3) $ _randGen w
|
||||
makeFlameletTimed
|
||||
:: Point2 -- ^ Position
|
||||
-> Point2 -- ^ Velocity
|
||||
-> Maybe Int -- ^ Creature id
|
||||
-> Float -- ^ Size
|
||||
-> Int -- ^ Timer
|
||||
-> World
|
||||
-> World
|
||||
makeFlameletTimed pos vel maycid size time w = w
|
||||
& randGen .~ g
|
||||
& particles %~ (theFlamelet :)
|
||||
where
|
||||
theFlamelet = Pt'
|
||||
{ _ptDraw = drawFlamelet rot
|
||||
, _ptUpdate' = moveFlamelet
|
||||
, _btVel' = vel
|
||||
, _btColor' = red
|
||||
, _btPos' = pos
|
||||
, _btPassThrough' = maycid
|
||||
, _btWidth' = size
|
||||
, _btTimer' = time
|
||||
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
|
||||
}
|
||||
(rot ,g) = randomR (0,3) $ _randGen w
|
||||
|
||||
drawFlamelet :: Float -> Particle' -> Picture
|
||||
drawFlamelet
|
||||
:: Float -- ^ Rotation
|
||||
-> Particle
|
||||
-> Picture
|
||||
drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow]
|
||||
where
|
||||
sp = _btPos' pt
|
||||
@@ -133,30 +169,40 @@ drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow]
|
||||
time = _btTimer' pt
|
||||
glow = setDepth 0.336 $ uncurry translate ep
|
||||
$ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30
|
||||
piu = setDepth 0.334 $ uncurry translate ep
|
||||
$ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time))
|
||||
$ scale s1 s1
|
||||
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
|
||||
pi2 = setDepth 0.332 $ uncurry translate ep
|
||||
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
|
||||
orange (dark red)
|
||||
)
|
||||
$ rotate (0 - (rot + 0.2 * fromIntegral time))
|
||||
$ scale s2 s2
|
||||
$ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2)
|
||||
pic = setDepth 0.33 $ uncurry translate ep
|
||||
$ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
|
||||
white (dark red)
|
||||
)
|
||||
$ rotate (0 - ( 0.1 * fromIntegral time + rot))
|
||||
$ scale sc sc
|
||||
$ polygon [(-size,-size),(size,-size),(size,size),(-size,size)]
|
||||
piu = setDepth 0.334
|
||||
. uncurry translate ep
|
||||
. color (dark red)
|
||||
. rotate (negate (rot - 0.1 * fromIntegral time))
|
||||
. scale s1 s1
|
||||
. polygon
|
||||
$ rectNSWE siz2 (-siz2) (-siz2) siz2
|
||||
pi2 = setDepth 0.332
|
||||
. uncurry translate ep
|
||||
. color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
|
||||
orange (dark red)
|
||||
)
|
||||
. rotate (negate (rot + 0.2 * fromIntegral time))
|
||||
. scale s2 s2
|
||||
. polygon
|
||||
$ rectNSWE siz2 (-siz2) (-siz2) siz2
|
||||
pic = setDepth 0.33
|
||||
. uncurry translate ep
|
||||
. color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
|
||||
white (dark red)
|
||||
)
|
||||
. rotate (negate ( 0.1 * fromIntegral time + rot))
|
||||
. scale sc sc
|
||||
$ polygon [(-size,-size),(size,-size),(size,size),(-size,size)]
|
||||
sc = (*) 2 $ log $ 1 + fromIntegral time / 20
|
||||
s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
|
||||
s2 = 0.5 * (sc + s1)
|
||||
thepicture = pictures [pic , piu , pi2 , glow]
|
||||
|
||||
moveFlamelet :: World -> Particle' -> (World, Maybe Particle')
|
||||
{-
|
||||
Update of a flamelet.
|
||||
Applies movement and attaches damage to nearby creatures.
|
||||
-}
|
||||
moveFlamelet :: World -> Particle -> (World, Maybe Particle)
|
||||
moveFlamelet w pt
|
||||
| _btTimer' pt <= 0 = ( w, Nothing)
|
||||
| otherwise = (damcrs, mvPt)
|
||||
@@ -169,33 +215,46 @@ moveFlamelet w pt
|
||||
& btPos' .~ ep
|
||||
& btPassThrough' .~ Nothing
|
||||
& btVel' .~ 0.8 *.* vel
|
||||
damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w
|
||||
-- damcrs = w
|
||||
closeCrs cr = dist ep (_crPos cr) < _crRad cr + size
|
||||
dodam cr = over (creatures . ix (_crID cr) . crState . crDamage)
|
||||
((:) $ Flaming 3 sp ep ep)
|
||||
damcrs = w & creatures %~ IM.map damifclose
|
||||
isClose cr = dist ep (_crPos cr) < _crRad cr + size
|
||||
damifclose cr
|
||||
| isClose cr = cr & crState . crDamage %~ ( Flaming 3 sp ep ep : )
|
||||
| otherwise = cr
|
||||
|
||||
makeGasCloud :: Point2 -> Point2 -> World -> World
|
||||
makeGasCloud pos vel w = over clouds (IM.insert i theCloud)
|
||||
$ set randGen g w
|
||||
where i = newKey $ _clouds w
|
||||
theCloud = Cloud { _clID = i
|
||||
, _clPos = pos
|
||||
, _clVel = vel
|
||||
, _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col)
|
||||
$ circleSolid 20
|
||||
, _clRad = 20
|
||||
, _clTimer = 400
|
||||
, _clEffect = cloudPoisonDamage
|
||||
}
|
||||
(col, g) = runState (takeOne [green,yellow]) $ _randGen w
|
||||
makeGasCloud
|
||||
:: Point2 -- ^ Position
|
||||
-> Point2 -- ^ Velocity
|
||||
-> World
|
||||
-> World
|
||||
makeGasCloud pos vel w = w
|
||||
& clouds %~ IM.insert i theCloud
|
||||
& randGen .~ g
|
||||
where
|
||||
i = newKey $ _clouds w
|
||||
theCloud = Cloud { _clID = i
|
||||
, _clPos = pos
|
||||
, _clVel = vel
|
||||
, _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col)
|
||||
$ circleSolid 20
|
||||
, _clRad = 20
|
||||
, _clTimer = 400
|
||||
, _clEffect = cloudPoisonDamage
|
||||
}
|
||||
(col, g) = runState (takeOne [green,yellow]) $ _randGen w
|
||||
|
||||
{-
|
||||
Attach poison cloud damage to creatures near cloud.
|
||||
-}
|
||||
cloudPoisonDamage :: Cloud -> World -> World
|
||||
cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs
|
||||
where damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (_clPos c) w
|
||||
f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c
|
||||
doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1)
|
||||
where
|
||||
damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (_clPos c) w
|
||||
f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c
|
||||
doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1)
|
||||
|
||||
{-
|
||||
TODO: make tesla arc a particle.
|
||||
-}
|
||||
makeTeslaArcAt :: Int -> Point2 -> Float -> Projectile
|
||||
makeTeslaArcAt i pos dir = Projectile
|
||||
{ _pjPos = pos
|
||||
@@ -206,7 +265,12 @@ makeTeslaArcAt i pos dir = Projectile
|
||||
, _pjUpdate = moveTeslaArc pos dir i
|
||||
}
|
||||
|
||||
moveTeslaArc :: Point2 -> Float -> Int -> World -> World
|
||||
moveTeslaArc
|
||||
:: Point2 -- ^ Emmission position
|
||||
-> Float -- ^ Emmission direction
|
||||
-> Int -- ^ Projectile id
|
||||
-> World
|
||||
-> World
|
||||
moveTeslaArc p d i w =
|
||||
set (projectiles . ix i . pjPict) pic
|
||||
$ set (projectiles . ix i . pjUpdate)
|
||||
@@ -214,37 +278,44 @@ moveTeslaArc p d i w =
|
||||
$ set randGen g
|
||||
$ createSpark 8 nc q2 (argV sv + d1) Nothing
|
||||
$ foldr damCrs w hitCrs
|
||||
where pic = setLayer 1 $ pictures
|
||||
[ onLayer PtLayer $ color (f2 nc) $ line ps'
|
||||
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps'
|
||||
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps'
|
||||
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps'
|
||||
]
|
||||
ps' = lightningMids d pers ps
|
||||
ps = take 15 $ p : map f (crsLightChain p d 0 w)
|
||||
f (E3x1 cr) = _crPos cr
|
||||
f (E3x2 p1) = p1
|
||||
f (E3x3 p1) = p1
|
||||
pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w
|
||||
(nc,g) = randomR (0::Int,11) $ _randGen w
|
||||
f1 (E3x1 cr) = Just $ _crID cr
|
||||
f1 _ = Nothing
|
||||
hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
|
||||
damCrs i = over (creatures . ix i . crHP) (\hp -> hp - 5)
|
||||
f2 0 = cyan
|
||||
f2 1 = azure
|
||||
f2 _ = white
|
||||
sID = newProjectileKey w
|
||||
q1 = last $ init ps'
|
||||
q2 = last ps'
|
||||
hitWall = collidePointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
|
||||
(d1,_) = randomR (-0.7,0.7) $ _randGen w
|
||||
sv = fromMaybe (q2 -.- q1) $ fmap snd hitWall
|
||||
where
|
||||
pic = setLayer 1 $ pictures
|
||||
[ onLayer PtLayer $ color (f2 nc) $ line ps'
|
||||
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps'
|
||||
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps'
|
||||
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps'
|
||||
]
|
||||
ps' = lightningMids d pers ps
|
||||
ps = take 15 $ p : map f (crsLightChain p d 0 w)
|
||||
f (E3x1 cr) = _crPos cr
|
||||
f (E3x2 p1) = p1
|
||||
f (E3x3 p1) = p1
|
||||
pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w
|
||||
(nc,g) = randomR (0::Int,11) $ _randGen w
|
||||
f1 (E3x1 cr) = Just $ _crID cr
|
||||
f1 _ = Nothing
|
||||
hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
|
||||
damCrs i = over (creatures . ix i . crHP) (\hp -> hp - 5)
|
||||
f2 0 = cyan
|
||||
f2 1 = azure
|
||||
f2 _ = white
|
||||
sID = newProjectileKey w
|
||||
q1 = last $ init ps'
|
||||
q2 = last ps'
|
||||
hitWall = collidePointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
|
||||
(d1,_) = randomR (-0.7,0.7) $ _randGen w
|
||||
sv = maybe (q2 -.- q1) snd hitWall
|
||||
|
||||
{-
|
||||
Finds a point somewhere roughly inbetween two points.
|
||||
-}
|
||||
lightningMid :: Float -> Point2 -> Point2 -> Point2
|
||||
lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3
|
||||
where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2
|
||||
|
||||
{-
|
||||
Finds extra middle points between successive points in a list of points.
|
||||
-}
|
||||
lightningMids :: Float -> [Point2] -> [Point2] -> [Point2]
|
||||
lightningMids d1 (p:pers) (p1:p3:ps)
|
||||
= let p2 = p +.+ lightningMid d1 p1 p3
|
||||
@@ -252,15 +323,10 @@ lightningMids d1 (p:pers) (p1:p3:ps)
|
||||
in p1 : p2 : lightningMids d2 pers (p3:ps)
|
||||
lightningMids _ _ ps = ps
|
||||
|
||||
crsLightChain' :: Point2 -> Float -> World -> [Either3 Creature Point2 Point2]
|
||||
crsLightChain' p d w
|
||||
= case crOrWall p d w of
|
||||
E3x1 cr -> E3x1 cr : crsLightChain' (_crPos cr) (argV (_crPos cr -.- p)) w
|
||||
E3x2 p1 -> [E3x2 p1]
|
||||
E3x3 p1 -> E3x3 p1 : crsLightChain' p1 (dChange + argV (p1 -.- p)) (set randGen g w)
|
||||
-- where (dChange, g) = (0, _randGen w)
|
||||
where (dChange, g) = randomR (-0.05,0.05) $ _randGen w
|
||||
|
||||
{-
|
||||
Finds a list of hit things from a given point.
|
||||
'E3x1' objects are creatures, 'E3x2' objects are points on walls, 'E3x3' objects are points in space.
|
||||
-}
|
||||
crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2]
|
||||
crsLightChain p d wlAttract w
|
||||
= case crOrWallSensitive p d wlAttract w of
|
||||
@@ -271,73 +337,92 @@ crsLightChain p d wlAttract w
|
||||
-- where (dChange, g) = (0, _randGen w)
|
||||
where (dChange, g) = randomR (-0.05,0.05) $ _randGen w
|
||||
|
||||
crOrWallSensitive :: Point2 -> Float -> Float -> World -> Either3 Creature Point2 Point2
|
||||
crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
|
||||
$ listToMaybe $ sortBy (compare `on` g)
|
||||
$ catMaybes [cr,wlp]
|
||||
where cr = fmap E3x1 $ nearestCrInFront p dir 100 w
|
||||
wlp = fmap E3x2 $ listToMaybe
|
||||
$ sortBy (compare `on` dist p)
|
||||
$ mapMaybe
|
||||
( fmap fst
|
||||
. (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w)
|
||||
. (+.+) p
|
||||
. (\d -> rotateV d (100,0))
|
||||
. (+) dir
|
||||
)
|
||||
(fmap (*wlAttract) [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8])
|
||||
--[-pi/4,-pi/8,0,pi/8,pi/4]
|
||||
g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first
|
||||
--g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first
|
||||
g (E3x1 cr1) = dist p $ _crPos cr1
|
||||
(arcLen,_) = randomR (25,50) $ _randGen w
|
||||
{-
|
||||
Finds whether a creature or wall is in front of a given point and direction.
|
||||
Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'.
|
||||
Has a parameter to tweak how attracted the test is to walls.
|
||||
-}
|
||||
crOrWallSensitive
|
||||
:: Point2 -- ^ Start point
|
||||
-> Float -- ^ Direction (radians)
|
||||
-> Float -- ^ Wall attraction parameter
|
||||
-> World
|
||||
-> Either3 Creature Point2 Point2
|
||||
crOrWallSensitive p dir wlAttract w =
|
||||
fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
|
||||
. listToMaybe
|
||||
. sortBy (compare `on` g)
|
||||
$ catMaybes [cr,wlp]
|
||||
where
|
||||
cr = E3x1 <$> nearestCrInFront p dir 100 w
|
||||
wlp = fmap E3x2
|
||||
. listToMaybe
|
||||
. sortBy (compare `on` dist p)
|
||||
$ mapMaybe
|
||||
( fmap fst
|
||||
. (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w)
|
||||
. (+.+) p
|
||||
. (\d -> rotateV d (100,0))
|
||||
. (+ dir)
|
||||
. (* wlAttract)
|
||||
)
|
||||
[-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
|
||||
g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first
|
||||
--g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first
|
||||
g (E3x1 cr1) = dist p $ _crPos cr1
|
||||
(arcLen,_) = randomR (25,50) $ _randGen w
|
||||
-- BUG: can hit crs through walls
|
||||
|
||||
{-
|
||||
Finds whether a creature or wall is in front of a given point and direction.
|
||||
Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'.
|
||||
-}
|
||||
crOrWall :: Point2 -> Float -> World -> Either3 Creature Point2 Point2
|
||||
crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
|
||||
$ listToMaybe $ sortBy (compare `on` g)
|
||||
$ catMaybes [cr,wlp]
|
||||
where cr = fmap E3x1 $ nearestCrInFront p dir 100 w
|
||||
wlp = fmap E3x2 $ listToMaybe
|
||||
$ sortBy (compare `on` dist p)
|
||||
$ mapMaybe
|
||||
( fmap fst
|
||||
. (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w)
|
||||
. (+.+) p
|
||||
. (\d -> rotateV d (100,0))
|
||||
. (+) dir
|
||||
)
|
||||
[-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
|
||||
--[-pi/4,-pi/8,0,pi/8,pi/4]
|
||||
g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first
|
||||
--g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first
|
||||
g (E3x1 cr1) = dist p $ _crPos cr1
|
||||
(arcLen,_) = randomR (25,50) $ _randGen w
|
||||
where
|
||||
cr = E3x1 <$> nearestCrInFront p dir 100 w
|
||||
wlp = fmap E3x2 $ listToMaybe
|
||||
$ sortBy (compare `on` dist p)
|
||||
$ mapMaybe
|
||||
( fmap fst
|
||||
. (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w)
|
||||
. (+.+) p
|
||||
. (\d -> rotateV d (100,0))
|
||||
. (+) dir
|
||||
)
|
||||
[-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
|
||||
--[-pi/4,-pi/8,0,pi/8,pi/4]
|
||||
g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first
|
||||
--g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first
|
||||
g (E3x1 cr1) = dist p $ _crPos cr1
|
||||
(arcLen,_) = randomR (25,50) $ _randGen w
|
||||
|
||||
-- | Create a spark.
|
||||
-- If the spark is created by another Particle, it cannot be directly added to
|
||||
-- the list, hence the redirect through worldEvents.
|
||||
createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
|
||||
createSpark time colid pos dir maycid w
|
||||
= over worldEvents ((.) ( over particles' (spark :) . sparkFlashAt pos')) w
|
||||
= w & worldEvents %~ ( (over particles (spark :) . sparkFlashAt pos') . )
|
||||
where
|
||||
spark = Bul' { _ptDraw = drawBul
|
||||
, _ptUpdate' = mvGenBullet'
|
||||
, _btVel' = rotateV dir (5,0)
|
||||
, _btColor' = numColor colid
|
||||
, _btTrail' = [pos]
|
||||
, _btPassThrough' = maycid
|
||||
, _btWidth' = 1
|
||||
, _btTimer' = time
|
||||
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
|
||||
}
|
||||
x = fst $ randomR (0,20) $ _randGen w
|
||||
pos' = pos +.+ rotateV dir (x,0)
|
||||
sparkEff bt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
|
||||
((:) $ SparkDam 1 sp p ep)
|
||||
spark = Bul'
|
||||
{ _ptDraw = drawBul
|
||||
, _ptUpdate' = mvGenBullet'
|
||||
, _btVel' = rotateV dir (5,0)
|
||||
, _btColor' = numColor colid
|
||||
, _btTrail' = [pos]
|
||||
, _btPassThrough' = maycid
|
||||
, _btWidth' = 1
|
||||
, _btTimer' = time
|
||||
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
|
||||
}
|
||||
pos' = pos +.+ rotateV dir (5,0)
|
||||
sparkEff bt p cr
|
||||
= creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
|
||||
where
|
||||
sp = head (_btTrail' bt)
|
||||
ep = sp +.+ _btVel' bt
|
||||
|
||||
drawBul :: Particle' -> Picture
|
||||
drawBul :: Particle -> Picture
|
||||
drawBul pt = setLayer 1 . color white $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt)
|
||||
|
||||
@@ -1,19 +1,27 @@
|
||||
{-
|
||||
Find which objects lie upon a line.
|
||||
-}
|
||||
module Dodge.WorldEvent.ThingsHit
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
|
||||
import Geometry
|
||||
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Function (on)
|
||||
|
||||
thingsHit :: Point2 -> Point2 -> World -> [(Point2, Either3 Creature Wall ForceField)]
|
||||
{-
|
||||
List those objects that appear on a line.
|
||||
-}
|
||||
thingsHit
|
||||
:: Point2 -- ^ Line start point
|
||||
-> Point2 -- ^ Line end point
|
||||
-> World
|
||||
-> [(Point2, Either3 Creature Wall ForceField)]
|
||||
thingsHit sp ep w
|
||||
| sp == ep = []
|
||||
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
|
||||
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
|
||||
where
|
||||
hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
|
||||
$ _creatures w
|
||||
@@ -31,9 +39,16 @@ thingsHit sp ep w
|
||||
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
|
||||
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
|
||||
|
||||
|
||||
thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World
|
||||
-> [(Point2, (Either3 Creature Wall ForceField))]
|
||||
{-
|
||||
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, Either3 Creature Wall ForceField)]
|
||||
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
|
||||
thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
|
||||
where
|
||||
|
||||
Reference in New Issue
Block a user