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

Cleanup

Browse Source
This commit is contained in:
justin
2021-12-15 22:21:58 +00:00
parent 9dadea2c36
commit 9ead5b3979
11 changed files with 130 additions and 174 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+6 -6
View File
@@ -460,13 +460,13 @@ data Particle
, _ptTimer :: Int
, _ptColor :: Color
}
| BulletPt
| BulletPt
{ _ptDraw :: Particle -> Picture
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptVel :: Point2
, _btDrag :: Float
, _btColor' :: Color
, _btTrail' :: [Point2]
, _ptColor :: Color
, _ptTrail :: [Point2]
, _btPassThrough' :: Maybe Int
, _btWidth' :: Float
, _btTimer' :: Int
@@ -476,7 +476,7 @@ data Particle
{ _ptDraw :: Particle -> Picture
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptVel :: Point2
, _btColor' :: Color
, _ptColor :: Color
, _btPos' :: Point2
, _btPassThrough' :: Maybe Int
, _btWidth' :: Float
@@ -484,10 +484,10 @@ data Particle
, _btHitEffect' :: HitEffect
, _ptZ :: Float
}
| Shockwave'
| Shockwave
{ _ptDraw :: Particle -> Picture
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _btColor' :: Color
, _ptColor :: Color
, _btPos' :: Point2
, _btRad' :: Float
, _btDam' :: Int
src/Dodge/Item/Weapon/Bullet.hs
+1 -1
View File
@@ -37,7 +37,7 @@ bounceBullet = BulletAmmo
{ _amString = "BOUNCING"
, _amBulEff = destroyOnImpact bulHitCr bulBounceWall
, _amBulWth = 2
, _amBulVel = V2 40 0
, _amBulVel = V2 50 0
}
ltBullet :: AmmoType
ltBullet = BulletAmmo
src/Dodge/Magnet.hs
+3 -3
View File
@@ -6,12 +6,12 @@ import Control.Lens
dampField :: Magnet -> Particle -> Particle
dampField mg pt = case pt of
BulletPt{} | dist (head $ _btTrail' pt) (_mgPos mg) < 100 -> pt & ptVel *~ 0.5
BulletPt{} | dist (head $ _ptTrail pt) (_mgPos mg) < 100 -> pt & ptVel *~ 0.5
_ -> pt
curveLeftField :: Magnet -> Particle -> Particle
curveLeftField mg pt = case pt of
BulletPt{} | dist (head $ _btTrail' pt) (_mgPos mg) < 500 -> pt & ptVel %~ rotateV 0.2
BulletPt{} | dist (head $ _ptTrail pt) (_mgPos mg) < 500 -> pt & ptVel %~ rotateV 0.2
_ -> pt
curveAroundField :: Float -> Float -> Magnet -> Particle -> Particle
@@ -20,7 +20,7 @@ curveAroundField minrad maxrad mg pt = case pt of
where
thedist = dist btpos mgpos
mgpos = _mgPos mg
btpos = head $ _btTrail' pt
btpos = head $ _ptTrail pt
rotateToCircle vel
| (isLHS mgpos btpos (btpos +.+ vel) && isRHS mgpos btpos (mgpos +.+ vNormal vel) )
|| (isRHS mgpos btpos (btpos +.+ vel) && isLHS mgpos btpos (mgpos +.+ vNormal vel) )
src/Dodge/Particle/Bullet/Draw.hs
+4 -3
View File
@@ -5,6 +5,7 @@ import Dodge.Data
import Picture
drawBul :: Particle -> Picture
drawBul pt = setLayer 1 . setDepth 20 . color thecolor $ thickLine (take 3 $ _btTrail' pt) (_btWidth' pt)
where
thecolor = _btColor' pt
drawBul pt = setLayer 1
. setDepth 20
. color (_ptColor pt)
$ thickLine (take 3 $ _ptTrail pt) (_btWidth' pt)
src/Dodge/Particle/Bullet/HitEffect.hs
+50 -65
View File
@@ -1,8 +1,5 @@
{- |
Effects of bullets upon impact with walls or creatures.
-}
module Dodge.Particle.Bullet.HitEffect
where
{- | Effects of bullets upon impact with walls or creatures. -}
module Dodge.Particle.Bullet.HitEffect where
import Dodge.Data
import Dodge.Particle.Spark
import Dodge.Wall.Damage
@@ -14,27 +11,25 @@ import Dodge.WorldEvent.Shockwave
import Dodge.Creature.Property
import Dodge.Wall.Reflect
import Geometry
--import Geometry.Vector3D
import Picture
import LensHelp
import System.Random
import Control.Lens
import Control.Monad.State
-- | Basic bullet hit creature effect.
bulHitCr :: Particle -> Point2 -> Creature -> World -> World
bulHitCr bt p cr w
| crIsArmouredFrom p cr
= colSpark 8 colID p1 (argV (p1 -.- p)) $ addDamageArmoured w
= colSpark 8 (_ptColor bt) p1 (argV (p1 -.- p)) $ addDamageArmoured w
| otherwise = addDamage . bulletHitSound p $ w
where
sp = head $ _btTrail' bt
sp = head $ _ptTrail bt
bulVel = _ptVel bt
ep = sp +.+ bulVel
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
addDamage = creatures . ix cid . crState . crDamage .++~ (Piercing 100 sp p ep : mvDams)
addDamageArmoured = creatures . ix cid . crState . crDamage .++~ mvDams
cid = _crID cr
colID = _btColor' bt
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
bulletHitSound :: Point2 -> World -> World
@@ -45,38 +40,35 @@ bulBounceArmCr' bt p cr w
| crIsArmouredFrom p cr = addBouncer . addDamageArmoured $ w
| otherwise = addDamage . bulletHitSound p $ w
where
sp = head $ _btTrail' bt
sp = head $ _ptTrail bt
bulVel = _ptVel bt
ep = sp +.+ bulVel
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
addDamage = creatures . ix cid . crState . crDamage .++~ (Piercing 100 sp p ep : mvDams)
addDamageArmoured = creatures . ix cid . crState . crDamage .++~ mvDams
cid = _crID cr
newDir = squashNormalizeV (p -.- _crPos cr)
pOut = p +.+ 2 *.* newDir
reflectVel = magV bulVel *.* newDir
addBouncer = worldEvents %~ ( over particles (bouncer :) . )
addBouncer = instantParticles .:~ bouncer
bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt)
(_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
{- | Bullet pass through creatures. -}
bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
bulPenCr' bt p cr w
= over (creatures . ix cid . crState . crDamage)
([Piercing 50 sp p ep
,Blunt 50 sp p ep
,TorqueDam 1 d1
,PushDam 1 $ 3 *.* (ep -.- sp)
]
++
)
$ bulletHitSound ep
$ over instantParticles (piercer :)
w
bulPenCr' bt p cr w = w
& instantParticles .:~ piercer
& bulletHitSound ep
& creatures . ix cid . crState . crDamage .++~
[Piercing 50 sp p ep
,Blunt 50 sp p ep
,TorqueDam 1 d1
,PushDam 1 $ 3 *.* (ep -.- sp)
]
where
(d1,_) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr
sp = head $ _btTrail' bt
sp = head $ _ptTrail bt
ep = sp +.+ _ptVel bt
piercer = (aGenBulAt (Just cid) p (_ptVel bt) (_btDrag bt)
(_btHitEffect' bt) (_btWidth' bt)
@@ -84,63 +76,56 @@ bulPenCr' bt p cr w
{- | Heavy bullet effects when hitting creature:
piercing, blunt, twisting and pushback damage all applied. -}
hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World
hvBulHitCr bt p cr w
= over (creatures . ix cid . crState . crDamage)
([Piercing 200 sp p ep
,Blunt 100 sp p ep
,TorqueDam 1 d1
,PushDam 1 $ 3 *.* (ep -.- sp)
]
++
)
$ bulletHitSound ep
w
hvBulHitCr bt p cr w = w
& creatures . ix cid . crState . crDamage .++~
[Piercing 200 sp p ep
,Blunt 100 sp p ep
,TorqueDam 1 d1
,PushDam 1 $ 3 *.* (ep -.- sp)
]
& bulletHitSound ep
where
(d1,_) = randomR (-0.7,0.7) $ _randGen w
cid = _crID cr
sp = head $ _btTrail' bt
sp = head $ _ptTrail bt
ep = sp +.+ _ptVel bt
{- | Create a flamelet when hitting a creature. -}
bulIncCr :: Particle -> Point2 -> Creature -> World -> World
bulIncCr bt p cr w
= over (creatures . ix cid . crState . crDamage)
( Piercing 60 sp p ep : )
$ bulletHitSound p
$ incFlamelets
w
bulIncCr bt p cr w = w
& makeFlameletTimed p 20 v Nothing 3 20
& bulletHitSound p
& creatures . ix cid . crState . crDamage .:~ Piercing 60 sp p ep
where
cid = _crID cr
sp = head $ _btTrail' bt
sp = head $ _ptTrail bt
ep = sp +.+ _ptVel bt
v = evalState (randInCirc 1) $ _randGen w
incFlamelets = over worldEvents $ (.) (makeFlameletTimed p 20 v Nothing 3 20)
{- | Creates a shockwave when hitting a creature. -}
bulConCr :: Particle -> Point2 -> Creature -> World -> World
bulConCr bt p cr
= over (creatures . ix cid . crState . crDamage) (Blunt 10 sp p ep :)
. over worldEvents (makeShockwaveAt [] p 15 4 1 white .)
bulConCr bt p cr = over (creatures . ix cid . crState . crDamage) (Blunt 10 sp p ep :)
. makeShockwaveAt [] p 15 4 1 white
. bulletHitSound p
where
cid = _crID cr
sp = head $ _btTrail' bt
sp = head $ _ptTrail bt
ep = sp +.+ _ptVel bt
{- | Hitting wall effects: create a spark, damage blocks. -}
bulHitWall :: Particle -> Point2 -> Wall -> World -> World
bulHitWall bt p = damageWall (Piercing 100 sp p ep)
where
ep = sp +.+ _ptVel bt
sp = head $ _btTrail' bt
sp = head $ _ptTrail bt
{- | Bounce off walls, do damage to blocks. -}
bulBounceWall :: Particle -> Point2 -> Wall -> World -> World
bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl . over worldEvents addBouncer
bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl
. over instantParticles (bouncer :)
where
ep = sp +.+ _ptVel bt
sp = head $ _btTrail' bt
sp = head $ _ptTrail bt
pOut = p +.+ squashNormalizeV (sp -.- p)
bouncer = (aGenBulAt Nothing pOut reflectVel 0.5 (_btHitEffect' bt) (_btWidth' bt)
bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt) (_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
reflectVel = reflVelWall wl (_ptVel bt)
addBouncer = ( over particles (bouncer : ) . )
-- the hack is to get around the fact that the particles list gets reset after
-- all projectiles in it are checked, so we cannot add to it as we accumulate over
-- this list
@@ -152,14 +137,14 @@ bulIncWall
-> Wall
-> World
-> World
bulIncWall bt p wl = damageWall (Blunt 50 sp p ep) wl . incFlamelets
bulIncWall bt p wl = damageWall (Blunt 50 sp p ep) wl
. makeFlameletTimed pOut 20 reflectVel Nothing 3 20
where
ep = sp +.+ _ptVel bt
sp = head $ _btTrail' bt
sp = head $ _ptTrail bt
pOut = p +.+ squashNormalizeV (sp -.- p)
wallV = uncurry (-.-) (_wlLine wl)
reflectVel = squashNormalizeV $ reflectIn wallV (_ptVel bt)
incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut 20 reflectVel Nothing 3 20)
{- | Create a shockwave on wall-}
bulConWall
:: Particle
@@ -168,12 +153,12 @@ bulConWall
-> World
-> World
bulConWall bt p wl = damageWall (Blunt 10 sp p ep) wl .
over worldEvents ( makeShockwaveAt [] p 15 4 1 white . )
makeShockwaveAt [] p 15 4 1 white
where
ep = sp +.+ _ptVel bt
sp = head $ _btTrail' bt
sp = head $ _ptTrail bt
hvBulHitWall
hvBulHitWall
:: Particle
-> Point2 -- ^ Impact point
-> Wall
@@ -184,7 +169,7 @@ hvBulHitWall bt p wl w = damageWall (Piercing 200 sp p ep) wl
$ set randGen g $ foldr ($) w (sparks pOut sv)
where
ep = sp +.+ _ptVel bt
sp = head $ _btTrail' bt
sp = head $ _ptTrail bt
pOut = p +.+ squashNormalizeV (sp -.- p)
(a, g) = randomR (-0.2,0.2) $ _randGen w
sv = unitVectorAtAngle $ a + reflDirWall sp p wl
src/Dodge/Particle/Bullet/Spawn.hs
+6 -6
View File
@@ -25,8 +25,8 @@ aGenBulAt maycid pos vel drag hiteff width = BulletPt
, _ptUpdate = mvBullet
, _ptVel = vel
, _btDrag = drag
, _btColor' = V4 2 2 2 2
, _btTrail' = [pos]
, _ptColor = V4 2 2 2 2
, _ptTrail = [pos]
, _btPassThrough' = maycid
, _btWidth' = width
, _btTimer' = 100
@@ -46,8 +46,8 @@ aDelayedBulAt vfact maycid pos vel drag hiteff width = BulletPt
, _ptUpdate = \w -> resetVel . mvBullet w
, _ptVel = vfact *.* vel
, _btDrag = drag
, _btColor' = V4 2 2 2 2
, _btTrail' = [pos]
, _ptColor = V4 2 2 2 2
, _ptTrail = [pos]
, _btPassThrough' = maycid
, _btWidth' = width
, _btTimer' = 100
@@ -70,8 +70,8 @@ aCurveBulAt maycid col pos control targ hiteff width = BulletPt
, _ptUpdate = \w -> mvBullet w . setVel
, _ptVel = V2 0 0
, _btDrag = 1
, _btColor' = col
, _btTrail' = [pos]
, _ptColor = col
, _ptTrail = [pos]
, _btPassThrough' = maycid
, _btWidth' = width
, _btTimer' = 100
src/Dodge/Particle/Bullet/Update.hs
+1 -1
View File
@@ -23,7 +23,7 @@ mvBullet w bt'
dodrag = ptVel %~ (drag *.*)
drag = _btDrag bt
mcr = _btPassThrough' bt
(p:_) = _btTrail' bt
(p:_) = _ptTrail bt
vel = _ptVel bt
hiteff = _btHitEffect' bt
t = _btTimer' bt
src/Dodge/Particle/Spark.hs
+7 -7
View File
@@ -21,8 +21,8 @@ createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt
, _ptUpdate = mvBullet
, _ptVel = rotateV dir (V2 5 0)
, _btDrag = 0.9
, _btColor' = numColor colid
, _btTrail' = [pos]
, _ptColor = numColor colid
, _ptTrail = [pos]
, _btPassThrough' = maycid
, _btWidth' = 1
, _btTimer' = time
@@ -31,7 +31,7 @@ createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt
where
sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep
where
sp = head (_btTrail' bt)
sp = head (_ptTrail bt)
ep = sp +.+ _ptVel bt
colSpark :: Int -> Color -> Point2 -> Float -> World -> World
colSpark = colSparkRandDir 0.7
@@ -47,14 +47,14 @@ colSparkRandDir randDir time col pos baseDir w = w
, _ptUpdate = mvBullet
, _btDrag = 0.9
, _ptVel = rotateV dir (V2 5 0)
, _btColor' = col
, _btTrail' = [pos]
, _ptColor = col
, _ptTrail = [pos]
, _btPassThrough' = Nothing
, _btWidth' = 1
, _btTimer' = time
, _btHitEffect' = destroyOnImpact sparkEff noEff
}
sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep
where
sp = head (_btTrail' bt)
sp = head (_ptTrail bt)
ep = sp +.+ _ptVel bt
src/Dodge/WorldEvent/HitEffect.hs
+7 -23
View File
@@ -6,29 +6,13 @@ module Dodge.WorldEvent.HitEffect
) where
import Dodge.Data
import Geometry
import LensHelp
import Data.Bifunctor
import Control.Lens
type HitCreatureEffect = Particle -> Point2 -> Creature -> World -> World
type HitWallEffect = Particle -> Point2 -> Wall -> World -> World
--passThroughAll
-- :: HitCreatureEffect
-- -> HitWallEffect
-- -> HitForceFieldEffect
-- -> Particle
-- -> [(Point2, Either3 Creature Wall ForceField)] -- ^ hit things
-- -> World
-- -> (World, Maybe Particle)
--passThroughAll _ _ _ pt _ w = (w, mvPt)
-- where
-- mvPt = Just $ pt & btTrail' .~ (newP : trl)
-- & btTimer' %~ (\t -> t - 1)
-- & btPassThrough' .~ Nothing
-- trl = _btTrail' pt
-- newP = head trl +.+ _btVel' pt
destroyOnImpact
:: HitCreatureEffect
-> HitWallEffect
@@ -43,7 +27,7 @@ destroyOnImpact crEff wlEff pt hitThings w = case hitThings of
mvPt :: Particle -> Maybe Particle
mvPt pt = Just $ pt
& btTrail' %~ f
& ptTrail %~ f
& btTimer' -~ 1
& btPassThrough' .~ Nothing
where
@@ -52,15 +36,15 @@ mvPt pt = Just $ pt
destroyAt :: Point2 -> Particle -> Maybe Particle
destroyAt hitp pt = Just $ pt
& ptUpdate .~ killBulletUpdate
& btTrail' %~ (hitp :)
& btTimer' %~ (\t -> min 3 (t-1))
& ptTrail .:~ hitp
& btTimer' %~ (min 3 . subtract 1)
killBulletUpdate :: World -> Particle -> (World,Maybe Particle)
killBulletUpdate w pt
| _btTimer' pt <= 0 = (w,Nothing)
| otherwise = (w
,Just $ pt & btTimer' -~ 1
& btTrail' %~ (\(x:xs) -> x:x:xs)
& ptTrail %~ (\(x:xs) -> x:x:xs)
)
penWalls
@@ -78,8 +62,8 @@ penWalls crEff wlEff pt hitThings w = case hitThings of
((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt)
doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World
doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage %~
(Flaming amount sp p ep :)
doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage .:~
Flaming amount sp p ep
where
sp = _btPos' pt
ep = sp +.+ _ptVel pt
src/Dodge/WorldEvent/Shockwave.hs
+30 -36
View File
@@ -1,8 +1,7 @@
module Dodge.WorldEvent.Shockwave
( makeShockwaveAt
, inverseShockwaveAt
)
where
) where
import Dodge.Data
import Dodge.Wall.Damage
import Dodge.Base
@@ -10,10 +9,9 @@ import Dodge.Zone
import Dodge.Picture.Layer
import Geometry
import Picture
import LensHelp
import qualified Data.IntMap.Strict as IM
import Control.Lens
-- currently very effective against walls
makeShockwaveAt
:: [Int] -- ^ IDs of invulnerable creatures.
@@ -24,25 +22,23 @@ makeShockwaveAt
-> Color -- ^ Color of shockwave.
-> World -- ^ Start world.
-> World
makeShockwaveAt is p rad dam push col = over particles (theShockwave :)
where
theShockwave = Shockwave'
{ _ptDraw = drawShockwave
, _ptUpdate = mvShockwave is
, _btColor' = col
, _btPos' = p
, _btRad' = rad
, _btDam' = dam
, _btPush' = push
, _btMaxTime' = 10
, _btTimer' = 10
}
makeShockwaveAt is p rad dam push col = instantParticles .:~ Shockwave
{ _ptDraw = drawShockwave
, _ptUpdate = mvShockwave is
, _ptColor = col
, _btPos' = p
, _btRad' = rad
, _btDam' = dam
, _btPush' = push
, _btMaxTime' = 10
, _btTimer' = 10
}
{- Shockwave picture. -}
drawShockwave :: Particle -> Picture
drawShockwave pt = setDepth 20
. setLayer 1
. setLayer 1
. uncurryV translate (_btPos' pt)
. color (_btColor' pt)
. color (_ptColor pt)
$ thickCircle rad thickness
where
r = _btRad' pt
@@ -69,8 +65,8 @@ mvShockwave is w pt
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damCr cr
| _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . crDamage %~
(PushDam dam (25 * push *.* squashNormalizeV (_crPos cr -.- p)) : )
| otherwise = cr & crState . crDamage .:~
PushDam dam (25 * push *.* squashNormalizeV (_crPos cr -.- p))
{- Create a shockwave going from an outside circle into a center point. -}
inverseShockwaveAt
:: Point2 -- Center position
@@ -79,19 +75,17 @@ inverseShockwaveAt
-> Float -- Push amount
-> World
-> World
inverseShockwaveAt p rad dam push = over particles (theShockwave :)
where
theShockwave = Shockwave'
{ _ptDraw = drawInverseShockwave
, _ptUpdate = moveInverseShockwave
, _btColor' = cyan
, _btPos' = p
, _btRad' = rad
, _btDam' = dam
, _btPush' = push
, _btMaxTime' = 10
, _btTimer' = 10
}
inverseShockwaveAt p rad dam push = particles .:~ Shockwave
{ _ptDraw = drawInverseShockwave
, _ptUpdate = moveInverseShockwave
, _ptColor = cyan
, _btPos' = p
, _btRad' = rad
, _btDam' = dam
, _btPush' = push
, _btMaxTime' = 10
, _btTimer' = 10
}
moveInverseShockwave
:: World
-> Particle
@@ -108,8 +102,8 @@ moveInverseShockwave w pt
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damCr cr
| dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . crDamage %~
(PushDam 1 (25 *.* squashNormalizeV (p -.- _crPos cr)) :)
| otherwise = cr & crState . crDamage .:~
PushDam 1 (25 *.* squashNormalizeV (p -.- _crPos cr))
drawInverseShockwave :: Particle -> Picture
drawInverseShockwave pt
src/Dodge/WorldEvent/SpawnParticle.hs
+15 -23
View File
@@ -1,6 +1,4 @@
{- |
Creation of particles in the world.
-}
{- | Creation of particles in the world. -}
module Dodge.WorldEvent.SpawnParticle
( makeGasCloud
, aFlameParticle
@@ -14,11 +12,8 @@ import Dodge.WorldEvent.Cloud
import Dodge.WorldEvent.Flash
import Dodge.SoundLogic
import Dodge.RandomHelp
--import Dodge.Debug
import Picture
import Geometry
--import Geometry.Vector3D
--import Geometry.Data
import qualified IntMapHelp as IM
import LensHelp
@@ -35,7 +30,7 @@ aFlameParticle t pos vel maycid = PtZ
{ _ptDraw = drawFlame vel
, _ptUpdate = moveFlame vel
, _ptVel = vel
, _btColor' = red
, _ptColor = red
, _btPos' = pos
, _btPassThrough' = maycid
, _btWidth' = 4
@@ -47,15 +42,14 @@ drawFlame
:: Point2 -- ^ Rotate direction
-> Particle
-> Picture
drawFlame rotd pt = thePic
drawFlame rotd pt = pictures
[ glow
, aPic 3 prot2 25 (V2 (scaleChange + 1) 2 ) $ V4 2 (-1) (-1) 0.5
, aPic 3 prot 22 (V2 (scaleChange + 0.5) 1) $ V4 1 0.5 0 2
, aPic 1 prot3 20 (V2 scaleChange 0.5 ) $ V4 1 1 1 1
]
where
ep = _btPos' pt
thePic = pictures
[ glow
, aPic 3 prot2 25 (V2 (scaleChange + 1) 2 ) $ V4 2 (-1) (-1) 0.5
, aPic 3 prot 22 (V2 (scaleChange + 0.5) 1) $ V4 1 0.5 0 2
, aPic 1 prot3 20 (V2 scaleChange 0.5 ) $ V4 1 1 1 1
]
aPic :: Int -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
aPic lay offset depth (V2 scalex scaley) col
= setLayer lay
@@ -124,11 +118,11 @@ makeFlameletTimed
-> World
makeFlameletTimed (V2 x y) z vel maycid size time w = w
& randGen .~ g
& particles .:~ PtZ
& instantParticles .:~ PtZ
{ _ptDraw = drawFlameletZ rot
, _ptUpdate = moveFlamelet
, _ptVel = vel
, _btColor' = red
, _ptVel = vel
, _ptColor = red
, _btPos' = V2 x y
, _btPassThrough' = maycid
, _btWidth' = size
@@ -202,7 +196,7 @@ moveFlamelet w pt
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 : )
| isClose cr = cr & crState . crDamage .:~ Flaming 3 sp ep ep
| otherwise = cr
-- | At writing the radius is half the size of the effect area
makeGasCloud
@@ -211,7 +205,7 @@ makeGasCloud
-> World
-> World
makeGasCloud pos vel w = w
& clouds %~ (theCloud :)
& clouds .:~ theCloud
& randGen .~ g
where
theCloud = Cloud
@@ -226,12 +220,10 @@ makeGasCloud pos vel w = w
, _clEffect = cloudPoisonDamage
}
(col, g) = runState (takeOne [green,yellow]) $ _randGen w
{-
Attach poison cloud damage to creatures near cloud.
-}
{- 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 (stripZ $ _clPos c) w
f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
doDam cr = cr & crState . crDamage %~ (PoisonDam 1 :)
doDam cr = cr & crState . crDamage .:~ PoisonDam 1