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