From 9ead5b3979f810134ce650f9b0b0a44c3b773e4e Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 15 Dec 2021 22:21:58 +0000 Subject: [PATCH] Cleanup --- src/Dodge/Data.hs | 12 +-- src/Dodge/Item/Weapon/Bullet.hs | 2 +- src/Dodge/Magnet.hs | 6 +- src/Dodge/Particle/Bullet/Draw.hs | 7 +- src/Dodge/Particle/Bullet/HitEffect.hs | 115 +++++++++++-------------- src/Dodge/Particle/Bullet/Spawn.hs | 12 +-- src/Dodge/Particle/Bullet/Update.hs | 2 +- src/Dodge/Particle/Spark.hs | 14 +-- src/Dodge/WorldEvent/HitEffect.hs | 30 ++----- src/Dodge/WorldEvent/Shockwave.hs | 66 +++++++------- src/Dodge/WorldEvent/SpawnParticle.hs | 38 ++++---- 11 files changed, 130 insertions(+), 174 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 2960b6d1d..0782c5e74 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index b5620adc8..33cff5e50 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -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 diff --git a/src/Dodge/Magnet.hs b/src/Dodge/Magnet.hs index 5c7e9a9fe..bc317e384 100644 --- a/src/Dodge/Magnet.hs +++ b/src/Dodge/Magnet.hs @@ -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) ) diff --git a/src/Dodge/Particle/Bullet/Draw.hs b/src/Dodge/Particle/Bullet/Draw.hs index a2803dae8..9e32e6616 100644 --- a/src/Dodge/Particle/Bullet/Draw.hs +++ b/src/Dodge/Particle/Bullet/Draw.hs @@ -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) diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 800391a0a..03cd8b538 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -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 diff --git a/src/Dodge/Particle/Bullet/Spawn.hs b/src/Dodge/Particle/Bullet/Spawn.hs index 21ed10ee3..e33d6eee5 100644 --- a/src/Dodge/Particle/Bullet/Spawn.hs +++ b/src/Dodge/Particle/Bullet/Spawn.hs @@ -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 diff --git a/src/Dodge/Particle/Bullet/Update.hs b/src/Dodge/Particle/Bullet/Update.hs index c1647cef4..9f13abd25 100644 --- a/src/Dodge/Particle/Bullet/Update.hs +++ b/src/Dodge/Particle/Bullet/Update.hs @@ -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 diff --git a/src/Dodge/Particle/Spark.hs b/src/Dodge/Particle/Spark.hs index 77b1c684e..c87cf2c2a 100644 --- a/src/Dodge/Particle/Spark.hs +++ b/src/Dodge/Particle/Spark.hs @@ -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 diff --git a/src/Dodge/WorldEvent/HitEffect.hs b/src/Dodge/WorldEvent/HitEffect.hs index 0f01f0d23..101e761ea 100644 --- a/src/Dodge/WorldEvent/HitEffect.hs +++ b/src/Dodge/WorldEvent/HitEffect.hs @@ -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 diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index f293d6333..97f859417 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -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 diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index c45bae1a1..c172f4e7a 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -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