Cleanup
This commit is contained in:
@@ -562,16 +562,6 @@ data Particle
|
|||||||
, _ptPoints :: [Point2]
|
, _ptPoints :: [Point2]
|
||||||
, _ptColor :: Color
|
, _ptColor :: Color
|
||||||
}
|
}
|
||||||
| PtStaticBall
|
|
||||||
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
|
|
||||||
, _ptVel :: Point2
|
|
||||||
, _ptColor :: Color
|
|
||||||
, _ptPos :: Point2
|
|
||||||
, _ptWidth :: Float
|
|
||||||
, _ptTimer :: Int
|
|
||||||
, _ptHitEff :: HitEffect
|
|
||||||
, _ptZ :: Float
|
|
||||||
}
|
|
||||||
| Shockwave
|
| Shockwave
|
||||||
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
|
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
|
||||||
, _ptColor :: Color
|
, _ptColor :: Color
|
||||||
|
|||||||
@@ -5,10 +5,21 @@ import Picture
|
|||||||
|
|
||||||
|
|
||||||
drawEnergyBall :: EnergyBall -> Picture
|
drawEnergyBall :: EnergyBall -> Picture
|
||||||
drawEnergyBall = drawFlameletEB
|
drawEnergyBall eb = case _ebEff eb of
|
||||||
|
(ELECTRICAL,_) -> drawStaticBall eb
|
||||||
|
(FLAMING,_) -> drawFlamelet eb
|
||||||
|
_ -> error "don't know how to draw an energy ball of this type"
|
||||||
|
|
||||||
drawFlameletEB :: EnergyBall -> Picture
|
drawStaticBall
|
||||||
drawFlameletEB pt = pictures
|
:: EnergyBall
|
||||||
|
-> Picture
|
||||||
|
drawStaticBall pt = setLayer BloomNoZWrite
|
||||||
|
. setDepth (_ebZ pt + 20)
|
||||||
|
. uncurryV translate (_ebPos pt)
|
||||||
|
$ circleSolidCol (_ebColor pt) (withAlpha 0.5 white) (_ebWidth pt+5)
|
||||||
|
|
||||||
|
drawFlamelet :: EnergyBall -> Picture
|
||||||
|
drawFlamelet pt = pictures
|
||||||
[ setLayer BloomLayer pic
|
[ setLayer BloomLayer pic
|
||||||
, setLayer BloomNoZWrite piu
|
, setLayer BloomNoZWrite piu
|
||||||
, setLayer BloomNoZWrite pi2
|
, setLayer BloomNoZWrite pi2
|
||||||
|
|||||||
@@ -2,12 +2,12 @@ module Dodge.Particle.Damage where
|
|||||||
import Dodge.Data
|
import Dodge.Data
|
||||||
import Geometry
|
import Geometry
|
||||||
|
|
||||||
simpleDam :: DamageType -> Int -> Particle -> Point2 -> [Damage]
|
--simpleDam :: DamageType -> Int -> Particle -> Point2 -> [Damage]
|
||||||
simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
|
--simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
|
||||||
where
|
-- where
|
||||||
sp = _ptPos bt
|
-- sp = _ptPos bt
|
||||||
bulVel = _ptVel bt
|
-- bulVel = _ptVel bt
|
||||||
ep = sp +.+ bulVel
|
-- ep = sp +.+ bulVel
|
||||||
simpleDam' :: DamageType -> Int -> Bullet -> Point2 -> [Damage]
|
simpleDam' :: DamageType -> Int -> Bullet -> Point2 -> [Damage]
|
||||||
simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
|
simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
|
||||||
where
|
where
|
||||||
|
|||||||
@@ -6,7 +6,6 @@ import Picture
|
|||||||
drawParticle :: Particle -> Picture
|
drawParticle :: Particle -> Picture
|
||||||
drawParticle pt = case pt of
|
drawParticle pt = case pt of
|
||||||
Shockwave {} -> drawShockwave pt
|
Shockwave {} -> drawShockwave pt
|
||||||
PtStaticBall {} -> drawStaticBall pt
|
|
||||||
PtInvShockwave {} -> drawInverseShockwave pt
|
PtInvShockwave {} -> drawInverseShockwave pt
|
||||||
PtTeslaArc {} -> drawTeslaArc pt
|
PtTeslaArc {} -> drawTeslaArc pt
|
||||||
PtTargetLaser {} -> drawTargetLaser pt
|
PtTargetLaser {} -> drawTargetLaser pt
|
||||||
@@ -27,15 +26,6 @@ drawShockwave pt = setDepth 20
|
|||||||
rad = r - (3/4) * r * tFraction
|
rad = r - (3/4) * r * tFraction
|
||||||
tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt)
|
tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt)
|
||||||
|
|
||||||
drawStaticBall
|
|
||||||
:: Particle
|
|
||||||
-> Picture
|
|
||||||
drawStaticBall pt = setLayer BloomNoZWrite
|
|
||||||
. setDepth (_ptZ pt + 20)
|
|
||||||
. uncurryV translate (_ptPos pt)
|
|
||||||
$ circleSolidCol (_ptColor pt) (withAlpha 0.5 white) (_ptWidth pt+5)
|
|
||||||
|
|
||||||
|
|
||||||
drawInverseShockwave :: Particle -> Picture
|
drawInverseShockwave :: Particle -> Picture
|
||||||
drawInverseShockwave pt
|
drawInverseShockwave pt
|
||||||
= setLayer BloomLayer $ setDepth 20 $ uncurryV translate p
|
= setLayer BloomLayer $ setDepth 20 $ uncurryV translate p
|
||||||
|
|||||||
+2
-1
@@ -12,6 +12,7 @@ import Geometry
|
|||||||
import LensHelp
|
import LensHelp
|
||||||
import Color
|
import Color
|
||||||
|
|
||||||
|
import qualified Data.IntMap.Strict as IM
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import System.Random
|
import System.Random
|
||||||
|
|
||||||
@@ -35,7 +36,7 @@ sparkDam
|
|||||||
-> World
|
-> World
|
||||||
sparkDam sk sp ep mayEiCrWl = case mayEiCrWl of
|
sparkDam sk sp ep mayEiCrWl = case mayEiCrWl of
|
||||||
(hitp,Left cr) -> creatures . ix (_crID cr) . crState . csDamage .:~ thedam hitp
|
(hitp,Left cr) -> creatures . ix (_crID cr) . crState . csDamage .:~ thedam hitp
|
||||||
(hitp,Right wl) -> wallDamages . ix (_wlID wl) .:~ thedam hitp
|
(hitp,Right wl) -> wallDamages %~ IM.insertWith (++) (_wlID wl) [thedam hitp]
|
||||||
where
|
where
|
||||||
thedam hitp = Damage (_skDamageType sk) 1 sp hitp ep NoDamageEffect
|
thedam hitp = Damage (_skDamageType sk) 1 sp hitp ep NoDamageEffect
|
||||||
|
|
||||||
|
|||||||
@@ -6,29 +6,27 @@ module Dodge.WorldEvent.SpawnParticle
|
|||||||
, randParticleAt
|
, randParticleAt
|
||||||
) where
|
) where
|
||||||
import Dodge.Data
|
import Dodge.Data
|
||||||
import Dodge.Zone
|
|
||||||
import Dodge.Particle.HitEffect.ExpireAndDamage
|
|
||||||
import Dodge.Particle.Damage
|
|
||||||
import Dodge.WorldEvent.Flash
|
|
||||||
import Dodge.WorldEvent.Shockwave
|
import Dodge.WorldEvent.Shockwave
|
||||||
import RandomHelp
|
import RandomHelp
|
||||||
import Picture
|
import Picture
|
||||||
import Geometry
|
import Geometry
|
||||||
import qualified IntMapHelp as IM
|
|
||||||
import LensHelp
|
import LensHelp
|
||||||
|
|
||||||
import Data.Foldable
|
|
||||||
import qualified Streaming.Prelude as S
|
|
||||||
|
|
||||||
randParticleAt :: (Point2 -> State StdGen Particle) -> Point2 -> World -> World
|
randParticleAt :: (Point2 -> State StdGen Particle) -> Point2 -> World -> World
|
||||||
randParticleAt f p w = w
|
randParticleAt f p w = w
|
||||||
& instantParticles .:~ thepart
|
& instantParticles .:~ thepart
|
||||||
& randGen .~ g
|
& randGen .~ g
|
||||||
where
|
where
|
||||||
(thepart,g) = runState (f p) (_randGen w)
|
(thepart,g) = runState (f p) (_randGen w)
|
||||||
|
randEnergyBallAt :: (Point2 -> State StdGen EnergyBall) -> Point2 -> World -> World
|
||||||
|
randEnergyBallAt f p w = w
|
||||||
|
& energyBalls .:~ thepart
|
||||||
|
& randGen .~ g
|
||||||
|
where
|
||||||
|
(thepart,g) = runState (f p) (_randGen w)
|
||||||
|
|
||||||
makeStaticBall :: Point2 -> World -> World
|
makeStaticBall :: Point2 -> World -> World
|
||||||
makeStaticBall p = randParticleAt aStaticBall p . (posEvents .:~ thesparker)
|
makeStaticBall p = randEnergyBallAt aStaticBall p . (posEvents .:~ thesparker)
|
||||||
where
|
where
|
||||||
thesparker = PosEvent SparkSpawner 10 p
|
thesparker = PosEvent SparkSpawner 10 p
|
||||||
|
|
||||||
@@ -44,40 +42,40 @@ concBall p = return Shockwave
|
|||||||
, _ptTimer = 10
|
, _ptTimer = 10
|
||||||
}
|
}
|
||||||
|
|
||||||
aStaticBall :: Point2 -> State g Particle
|
aStaticBall :: Point2 -> State g EnergyBall
|
||||||
aStaticBall p = return PtStaticBall
|
aStaticBall p = return EnergyBall
|
||||||
{ _ptUpdate = moveFlamelet
|
{ _ebVel = 0
|
||||||
, _ptVel = 0
|
, _ebColor = blue
|
||||||
, _ptColor = blue
|
, _ebPos = p
|
||||||
, _ptPos = p
|
, _ebWidth = 3
|
||||||
, _ptWidth = 3
|
, _ebTimer = 20
|
||||||
, _ptTimer = 20
|
, _ebEff = (ELECTRICAL,1)
|
||||||
, _ptHitEff = expireAndDamage $ simpleDam ELECTRICAL 20
|
, _ebZ = 20
|
||||||
, _ptZ = 20
|
, _ebRot = 0
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Note damgeInRadius by itself never destroys the particle
|
-- | Note damgeInRadius by itself never destroys the particle
|
||||||
damageInRadius :: Float -> Particle -> World -> World
|
--damageInRadius :: Float -> Particle -> World -> World
|
||||||
damageInRadius size pt = damageInArea isClose closeWls pt
|
--damageInRadius size pt = damageInArea isClose closeWls pt
|
||||||
where
|
-- where
|
||||||
p = _ptPos pt
|
-- p = _ptPos pt
|
||||||
closeWls wl = uncurry segOnCirc (_wlLine wl) p size
|
-- closeWls wl = uncurry segOnCirc (_wlLine wl) p size
|
||||||
isClose cr = dist p (_crPos cr) < _crRad cr + size
|
-- isClose cr = dist p (_crPos cr) < _crRad cr + size
|
||||||
|
|
||||||
damageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Particle -> World -> World
|
--damageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Particle -> World -> World
|
||||||
{-# INLINE damageInArea #-}
|
--{-# INLINE damageInArea #-}
|
||||||
damageInArea crt wlt pt w = damwls damcrs
|
--damageInArea crt wlt pt w = damwls damcrs
|
||||||
where
|
-- where
|
||||||
p = _ptPos pt
|
-- p = _ptPos pt
|
||||||
damcrs = foldl' (flip $ \cr -> fst . hiteff (S.yield (p,Left cr))) w $ IM.filter crt $ _creatures w
|
-- damcrs = foldl' (flip $ \cr -> fst . hiteff (S.yield (p,Left cr))) w $ IM.filter crt $ _creatures w
|
||||||
damwls w' = runIdentity
|
-- damwls w' = runIdentity
|
||||||
. S.fold_
|
-- . S.fold_
|
||||||
(flip $ \wl -> fst . hiteff (S.yield (p,Right wl)))
|
-- (flip $ \wl -> fst . hiteff (S.yield (p,Right wl)))
|
||||||
w'
|
-- w'
|
||||||
id
|
-- id
|
||||||
. S.filter wlt
|
-- . S.filter wlt
|
||||||
$ wlsNearPoint p w'
|
-- $ wlsNearPoint p w'
|
||||||
hiteff = _ptHitEff pt pt
|
-- hiteff = _ptHitEff pt pt
|
||||||
|
|
||||||
-- | At writing the radius is half the size of the effect area
|
-- | At writing the radius is half the size of the effect area
|
||||||
makeGasCloud
|
makeGasCloud
|
||||||
@@ -107,12 +105,12 @@ makeGasCloud pos vel w = w
|
|||||||
{- Update of a flamelet.
|
{- Update of a flamelet.
|
||||||
Applies movement and attaches damage to nearby creatures. -}
|
Applies movement and attaches damage to nearby creatures. -}
|
||||||
-- This should be unified in many ways with moveFlame
|
-- This should be unified in many ways with moveFlame
|
||||||
moveFlamelet :: World -> Particle -> (World, Maybe Particle)
|
--moveFlamelet :: World -> Particle -> (World, Maybe Particle)
|
||||||
moveFlamelet w pt
|
--moveFlamelet w pt
|
||||||
| _ptTimer pt <= 0 = ( w, Nothing)
|
-- | _ptTimer pt <= 0 = ( w, Nothing)
|
||||||
| otherwise = (ptFlicker pt $ damageInRadius 5 mvPt' w, Just mvPt')
|
-- | otherwise = (ptFlicker pt $ damageInRadius 5 mvPt' w, Just mvPt')
|
||||||
where
|
-- where
|
||||||
mvPt' = pt
|
-- mvPt' = pt
|
||||||
& ptTimer -~ 1
|
-- & ptTimer -~ 1
|
||||||
& ptPos .~ _ptPos pt +.+ _ptVel pt
|
-- & ptPos .~ _ptPos pt +.+ _ptVel pt
|
||||||
& ptVel .*.*~ 0.8
|
-- & ptVel .*.*~ 0.8
|
||||||
|
|||||||
Reference in New Issue
Block a user