From 0a7922ec5e81725084125cd63f1a98604a54229b Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 19 Jul 2022 13:15:13 +0100 Subject: [PATCH] Improve static bullets --- src/Dodge/Bullet.hs | 31 +++++++---- src/Dodge/Creature.hs | 2 + src/Dodge/Creature/State.hs | 2 +- src/Dodge/DamageCircle.hs | 29 +++++++++++ src/Dodge/Data.hs | 17 +++--- src/Dodge/Data/Bullet.hs | 4 +- src/Dodge/Data/EnergyBall.hs | 19 +++++++ src/Dodge/Data/PosEvent.hs | 14 +++++ src/Dodge/Default/World.hs | 2 + src/Dodge/EnergyBall.hs | 63 ++++++++++++++++++++++ src/Dodge/EnergyBall/Draw.hs | 52 +++++++++++++++++++ src/Dodge/Item/Weapon/Launcher.hs | 3 +- src/Dodge/Particle/Draw.hs | 45 ---------------- src/Dodge/PosEvent.hs | 25 +++++++++ src/Dodge/Render/ShapePicture.hs | 2 + src/Dodge/Update.hs | 14 +++++ src/Dodge/WorldEvent/Explosion.hs | 1 + src/Dodge/WorldEvent/SpawnParticle.hs | 75 +++++---------------------- src/Dodge/WorldEvent/ThingsHit.hs | 21 +++++++- 19 files changed, 287 insertions(+), 134 deletions(-) create mode 100644 src/Dodge/DamageCircle.hs create mode 100644 src/Dodge/Data/EnergyBall.hs create mode 100644 src/Dodge/Data/PosEvent.hs create mode 100644 src/Dodge/EnergyBall.hs create mode 100644 src/Dodge/EnergyBall/Draw.hs create mode 100644 src/Dodge/PosEvent.hs diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index e9727802a..05648692b 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -2,11 +2,12 @@ module Dodge.Bullet ( updateBullet , useAmmoParams ) where -import Dodge.WorldEvent.SpawnParticle +import Dodge.EnergyBall import Dodge.Creature.Test import Dodge.Data import Dodge.Creature.HandPos import Dodge.Base.Coordinate +import Dodge.WorldEvent.SpawnParticle import Geometry import LensHelp import StreamingHelp @@ -17,8 +18,6 @@ import Data.Maybe import Dodge.Movement.Turn import Dodge.WorldEvent.ThingsHit import Control.Monad.State -import System.Random ---import Data.Bifunctor updateBullet :: World -> Bullet -> (World,Maybe Bullet) updateBullet w bu = case _buState bu of @@ -54,16 +53,17 @@ useAmmoParams it cr w = w & instantBullets .:~ (_amBullet bultype {- Update for a generic bullet. -} mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet) mvBullet x w bt' - | t <= 0 || magV (_buVel bt) < 1 = (w,Nothing) + | t <= 0 || magV (_buVel bt) < 1 = (endspawn w,Nothing) | otherwise = bimap (maybespawn . maybebounce) (fmap dodrag) $ hiteff bt hitstream w where + endspawn w' = fromMaybe w' $ do + partspawn <- bulletSpawn bt' + return $ partspawn p w' maybespawn w' = fromMaybe w' $ do (hp,_) <- runIdentity (S.head_ hitstream) partspawn <- bulletSpawn bt' - let (thepart,g) = runState (partspawn hp) $ _randGen w' - return $ w' & instantParticles .:~ thepart - & randGen .~ g + return $ partspawn (hp +.+ normalizeV (_buPos bt' -.- hp)) w' maybebounce = fromMaybe id $ do guard (_buEffect bt' == BounceBullet) (hp,crwl) <- runIdentity (S.head_ hitstream) @@ -95,12 +95,21 @@ bounceDir (_,Right wl) = Just $ uncurry (-.-) (_wlLine wl) bounceDir (p,Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr bounceDir _ = Nothing -bulletSpawn :: Bullet -> Maybe (Point2 -> State StdGen Particle) +bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World) bulletSpawn bu = case _buSpawn bu of BulSpark -> Nothing - BulBall IncBall -> Just incBall - BulBall ConcBall -> Just concBall - BulBall TeslaBall -> Just aStaticBall + BulBall IncBall -> Just incBallAt + BulBall ConcBall -> Just $ randParticleAt concBall + BulBall TeslaBall -> Just makeStaticBall +-- where +-- dosatate st p w = w' +-- & +-- where +-- (pt,g) = runState do +-- partspawn <- bulletSpawn bt' +-- let (thepart,g) = runState (partspawn hp) $ _randGen w' +-- return $ w' & instantParticles .:~ thepart +-- & randGen .~ g hitEffFromBul :: Float -> Bullet -> Stream (Of (Point2, Either Creature Wall)) Identity () diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index e7dc927e0..d23a97dce 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -211,9 +211,11 @@ inventoryX c = case c of ] 'G' -> [ autoPistol + , pistol , makeTypeCraftNum 2 HARDWARE , makeTypeCraftNum 2 MAGNET , makeTypeCraftNum 5 INCENDIARYMODULE + , makeTypeCraftNum 5 CONCUSSMODULE , makeTypeCraftNum 5 STATICMODULE ] 'H' -> [ shatterGun ] diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 8e8459f8e..c1e0f194d 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -3,6 +3,7 @@ module Dodge.Creature.State , doDamage ) where import Dodge.Data +import Dodge.EnergyBall import Dodge.Damage import Dodge.Hammer import Dodge.Reloading @@ -14,7 +15,6 @@ import Dodge.Creature.Damage import Dodge.LightSource.Torch import Dodge.SoundLogic import RandomHelp -import Dodge.WorldEvent import Dodge.Creature.Action import Geometry import Picture diff --git a/src/Dodge/DamageCircle.hs b/src/Dodge/DamageCircle.hs new file mode 100644 index 000000000..c07eae129 --- /dev/null +++ b/src/Dodge/DamageCircle.hs @@ -0,0 +1,29 @@ +module Dodge.DamageCircle + ( damageCircle + ) where +import Dodge.Data +import Dodge.WorldEvent.ThingsHit +import Geometry +import LensHelp + +import qualified Streaming.Prelude as S +import qualified IntMapHelp as IM +damageCircle :: Float -> Point2 -> DamageType -> Int -> World -> World +damageCircle r sp dt da w = w + & wallDamages %~ addwalldamages + & creatures %~ addcreaturedamages + where + addwalldamages wlds = runIdentity $ S.fold_ (damageWlCircle wldam) wlds id wlstodam + wlstodam = wlsHitRadial sp r w + wldam p = Damage dt da sp p (sp +.+ r *.* normalizeV (p -.- sp)) NoDamageEffect + addcreaturedamages crs = runIdentity $ S.fold_ (damageCrCircle crdam) crs id crstodam + crdam p cr = Damage dt da sp p (_crPos cr) NoDamageEffect + crstodam = crsHitRadial sp r w + +damageWlCircle :: (Point2 -> Damage) + -> IM.IntMap [Damage] -> (Point2,Wall) -> IM.IntMap [Damage] +damageWlCircle f wldams (p,wl) = IM.insertWith (++) (_wlID wl) [f p] wldams + +damageCrCircle :: (Point2 -> Creature -> Damage) + -> IM.IntMap Creature -> (Point2,Creature) -> IM.IntMap Creature +damageCrCircle crdam crs (p,cr) = crs & ix (_crID cr) . crState . csDamage .:~ crdam p cr diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 0a7166e76..f65df5aee 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -10,6 +10,8 @@ circular imports are probably not a good idea. {-# LANGUAGE DerivingStrategies #-} module Dodge.Data ( module Dodge.Data + , module Dodge.Data.PosEvent + , module Dodge.Data.EnergyBall , module Dodge.Data.Flame , module Dodge.Data.Magnet , module Dodge.Data.Spark @@ -50,6 +52,8 @@ module Dodge.Data , module Dodge.Data.RadarBlip , module Dodge.Data.PathGraph ) where +import Dodge.Data.PosEvent +import Dodge.Data.EnergyBall import Dodge.Data.Flame import Dodge.Data.Magnet import Dodge.Data.Spark @@ -153,6 +157,8 @@ data World = World , _bullets :: [Bullet] , _instantParticles :: [Particle] , _particles :: [Particle] + , _energyBalls :: [EnergyBall] + , _posEvents :: [PosEvent] , _flames :: [Flame] , _sparks :: [Spark] , _radarBlips :: [RadarBlip] @@ -556,17 +562,6 @@ data Particle , _ptPoints :: [Point2] , _ptColor :: Color } - | PtIncBall - { _ptUpdate :: World -> Particle -> (World, Maybe Particle) - , _ptVel :: Point2 - , _ptColor :: Color - , _ptPos :: Point2 - , _ptWidth :: Float - , _ptTimer :: Int - , _ptHitEff :: HitEffect - , _ptZ :: Float - , _ptRot :: Float - } | PtStaticBall { _ptUpdate :: World -> Particle -> (World, Maybe Particle) , _ptVel :: Point2 diff --git a/src/Dodge/Data/Bullet.hs b/src/Dodge/Data/Bullet.hs index 4672e0682..3771d83e2 100644 --- a/src/Dodge/Data/Bullet.hs +++ b/src/Dodge/Data/Bullet.hs @@ -18,7 +18,7 @@ data Bullet = Bullet , _buTimer :: Int , _buDamages :: [Damage] } -data EnergyBall = IncBall | TeslaBall | ConcBall +data EnergyBallType = IncBall | TeslaBall | ConcBall data BulletState = NormalBulletState | DyingBulletState | DelayedBullet Float @@ -28,7 +28,7 @@ data BulletEffect | BounceBullet | PenetrateBullet deriving (Eq,Ord,Show,Read,Enum,Bounded) -data BulletSpawn = BulBall EnergyBall | BulSpark +data BulletSpawn = BulBall EnergyBallType | BulSpark data BulletTrajectory = BasicBulletTrajectory | BezierTrajectory Point2 Point2 Point2 diff --git a/src/Dodge/Data/EnergyBall.hs b/src/Dodge/Data/EnergyBall.hs new file mode 100644 index 000000000..94b09fc4c --- /dev/null +++ b/src/Dodge/Data/EnergyBall.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.EnergyBall where +import Geometry.Data +import Color +import Dodge.Data.Damage.Type +import Control.Lens + +data EnergyBall = EnergyBall + { _ebVel :: Point2 + , _ebColor :: Color + , _ebPos :: Point2 + , _ebWidth :: Float + , _ebTimer :: Int + , _ebEff :: (DamageType,Int) + , _ebZ :: Float + , _ebRot :: Float + } +makeLenses ''EnergyBall diff --git a/src/Dodge/Data/PosEvent.hs b/src/Dodge/Data/PosEvent.hs new file mode 100644 index 000000000..f1ab4098f --- /dev/null +++ b/src/Dodge/Data/PosEvent.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.PosEvent where +import Geometry.Data +import Control.Lens + +data PosEventType = SparkSpawner + +data PosEvent = PosEvent + { _pvType :: PosEventType + , _pvTimer :: Int + , _pvPos :: Point2 + } +makeLenses ''PosEvent diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 30b020c71..b6ab9d876 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -45,6 +45,8 @@ defaultWorld = World , _particles = [] , _flames = [] , _sparks = [] + , _posEvents = [] + , _energyBalls = [] , _radarBlips = [] , _flares = [] , _newBeams = WorldBeams [] [] [] [] diff --git a/src/Dodge/EnergyBall.hs b/src/Dodge/EnergyBall.hs new file mode 100644 index 000000000..805bd91c2 --- /dev/null +++ b/src/Dodge/EnergyBall.hs @@ -0,0 +1,63 @@ +module Dodge.EnergyBall where +import Dodge.Data +import Dodge.DamageCircle +import Dodge.LightSource +import Geometry +import Picture +import LensHelp +import RandomHelp + +makeFlamelet + :: Point2 -- ^ Position + -> Float -- ^ z position + -> Point2 -- ^ Velocity + -> Float -- ^ Size + -> Int -- ^ Timer + -> World + -> World +makeFlamelet (V2 x y) z vel size time w = w + & randGen .~ g + & energyBalls .:~ EnergyBall + { _ebVel = vel + , _ebColor = red + , _ebPos = V2 x y + , _ebWidth = size + , _ebTimer = time + , _ebEff = (FLAMING,1) + , _ebZ = z + , _ebRot = rot + } + where + (rot ,g) = randomR (0,3) $ _randGen w +moveEnergyBall :: World -> EnergyBall -> (World, Maybe EnergyBall) +moveEnergyBall w eb + | _ebTimer eb <= 0 = ( w, Nothing) + | otherwise = + ( ebFlicker eb $ uncurry (damageCircle 5 (_ebPos eb)) (_ebEff eb) w + , Just $ eb & ebTimer -~ 1 & ebPos .+.+~ _ebVel eb & ebVel .*.*~ 0.9 + ) + + +incBallAt :: Point2 -> World -> World +incBallAt p w = w & energyBalls .:~ theincball + & randGen .~ g + where + (theincball,g) = runState thestate (_randGen w) + thestate = do + rot <- state $ randomR (0,3) + return EnergyBall + { _ebVel = 0 + , _ebColor = red + , _ebPos = p + , _ebWidth = 3 + , _ebTimer = 20 + , _ebEff = (FLAMING,1) + , _ebZ = 20 + , _ebRot = rot + } + +ebFlicker :: EnergyBall -> World -> World +ebFlicker pt + | _ebTimer pt `mod` 7 == 0 = tempLightSources + .:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_ebColor pt)) (addZ 20 $ _ebPos pt) + | otherwise = id diff --git a/src/Dodge/EnergyBall/Draw.hs b/src/Dodge/EnergyBall/Draw.hs new file mode 100644 index 000000000..276213741 --- /dev/null +++ b/src/Dodge/EnergyBall/Draw.hs @@ -0,0 +1,52 @@ +module Dodge.EnergyBall.Draw where +import Dodge.Data +import Geometry +import Picture + + +drawEnergyBall :: EnergyBall -> Picture +drawEnergyBall = drawFlameletEB + +drawFlameletEB :: EnergyBall -> Picture +drawFlameletEB pt = pictures + [ setLayer BloomLayer pic + , setLayer BloomNoZWrite piu + , setLayer BloomNoZWrite pi2 + ] + where + z = _ebZ pt + sp = _ebPos pt + vel = _ebVel pt + ep = sp +.+ vel + size = _ebWidth pt + siz2 = size + 0.2 + time = _ebTimer pt + piu = setDepth (z + 25) + . uncurryV translate ep + . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) + (V4 2 0 0 1) (V4 2 0 0 0) + ) + . rotate (negate (rot - 0.1 * fromIntegral time)) + . scale s1 s1 + $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2) + pi2 = setDepth (z + 25) + . uncurryV translate ep + . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) + (V4 2 1 0 0.5) (V4 0 0 0 0) + ) + . rotate (negate (rot + 0.2 * fromIntegral time)) + . scale s2 s2 + $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2) + pic = setDepth (z + 20) + . uncurryV translate ep + . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) + (V4 1 1 1 3) (V4 1 0 0 1) + ) + . rotate (negate ( 0.1 * fromIntegral time + rot)) + . scale (0.5* sc) (0.5 *sc) + $ polygon $ map toV2 [(-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) + rot = _ebRot pt + diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 168c62160..4caed908c 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -6,7 +6,7 @@ module Dodge.Item.Weapon.Launcher ) where import Dodge.Data import Dodge.Reloading.Action ---import Dodge.Default +import Dodge.EnergyBall import Dodge.Default.Weapon import Dodge.Item.Location import Dodge.SoundLogic.LoadSound @@ -18,7 +18,6 @@ import Dodge.Movement.Turn import Dodge.Base import Dodge.Zone import Dodge.SoundLogic -import Dodge.WorldEvent.SpawnParticle import Dodge.WorldEvent.Cloud import RandomHelp import Geometry diff --git a/src/Dodge/Particle/Draw.hs b/src/Dodge/Particle/Draw.hs index d88d3ff23..71d4b92a7 100644 --- a/src/Dodge/Particle/Draw.hs +++ b/src/Dodge/Particle/Draw.hs @@ -7,7 +7,6 @@ drawParticle :: Particle -> Picture drawParticle pt = case pt of Shockwave {} -> drawShockwave pt PtStaticBall {} -> drawStaticBall pt - PtIncBall {} -> drawFlameletZ pt PtInvShockwave {} -> drawInverseShockwave pt PtTeslaArc {} -> drawTeslaArc pt PtTargetLaser {} -> drawTargetLaser pt @@ -36,50 +35,6 @@ drawStaticBall pt = setLayer BloomNoZWrite . uncurryV translate (_ptPos pt) $ circleSolidCol (_ptColor pt) (withAlpha 0.5 white) (_ptWidth pt+5) -drawFlameletZ - :: Particle - -> Picture -drawFlameletZ pt = pictures - [ setLayer BloomLayer pic - , setLayer BloomNoZWrite piu - , setLayer BloomNoZWrite pi2 - ] - where - z = _ptZ pt - sp = _ptPos pt - vel = _ptVel pt - ep = sp +.+ vel - size = _ptWidth pt - siz2 = size + 0.2 - time = _ptTimer pt - piu = setDepth (z + 25) - . uncurryV translate ep - . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) - (V4 2 0 0 1) (V4 2 0 0 0) - ) - . rotate (negate (rot - 0.1 * fromIntegral time)) - . scale s1 s1 - $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2) - pi2 = setDepth (z + 25) - . uncurryV translate ep - . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) - (V4 2 1 0 0.5) (V4 0 0 0 0) - ) - . rotate (negate (rot + 0.2 * fromIntegral time)) - . scale s2 s2 - $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2) - pic = setDepth (z + 20) - . uncurryV translate ep - . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) - (V4 1 1 1 3) (V4 1 0 0 1) - ) - . rotate (negate ( 0.1 * fromIntegral time + rot)) - . scale (0.5* sc) (0.5 *sc) - $ polygon $ map toV2 [(-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) - rot = _ptRot pt drawInverseShockwave :: Particle -> Picture drawInverseShockwave pt diff --git a/src/Dodge/PosEvent.hs b/src/Dodge/PosEvent.hs new file mode 100644 index 000000000..8fb29803b --- /dev/null +++ b/src/Dodge/PosEvent.hs @@ -0,0 +1,25 @@ +module Dodge.PosEvent where +import Dodge.Data +import Dodge.Spark +import Geometry.Data +import Color +import LensHelp + +import Control.Monad.State +import RandomHelp + +updatePosEvent :: World -> PosEvent -> (World, Maybe PosEvent) +updatePosEvent w pv + | _pvTimer pv < 1 = (w,Nothing) + | otherwise = (posEventEffect pv w,Just $ pv & pvTimer -~ 1) + +posEventEffect :: PosEvent -> World -> World +posEventEffect pv = case _pvType pv of + SparkSpawner -> spawnElectricalSparks (_pvPos pv) + +spawnElectricalSparks :: Point2 -> World -> World +spawnElectricalSparks p = randSpark ELECTRICAL rspeed rcol rdir p + where + rspeed = state (randomR (3,6)) + rcol = brightX 100 1.5 <$> takeOne [white,azure,blue,cyan] + rdir = state $ randomR (0,2*pi) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index b092f9f25..5b525ff91 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture ( worldSPic ) where import Dodge.Item.Draw.SPic +import Dodge.EnergyBall.Draw import Dodge.Creature.Picture.Awareness import Dodge.Creature.Picture import Dodge.Particle.Draw @@ -88,6 +89,7 @@ extraPics :: Configuration -> World -> Picture extraPics cfig w = pictures (_decorations w) <> concatMapPic drawParticle (_particles w) <> concatMapPic drawFlame (_flames w) + <> concatMapPic drawEnergyBall (_energyBalls w) <> concatMapPic drawSpark (_sparks w) <> concatMapPic drawBul (_bullets w) <> concatMapPic drawBlip (_radarBlips w) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 452751604..5e1d9457f 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -5,7 +5,9 @@ Description : Simulation update -} module Dodge.Update ( updateUniverse ) where import Dodge.Data +import Dodge.PosEvent import Dodge.Spark +import Dodge.EnergyBall import Dodge.Flame import Dodge.Bullet import Dodge.Update.Cloud @@ -84,7 +86,9 @@ functionalUpdate cfig w = checkEndGame . dbArg _worldEvents . updateIMl _modifications _mdUpdate . updateSparks + . updatePosEvents . updateFlames + . updateEnergyBalls . updateParticles . updateBullets . updateRadarBlips @@ -229,10 +233,20 @@ updateFlames w = w' & flames .~ catMaybes newflames where (w',newflames) = mapAccumR moveFlame w $ _flames w +updateEnergyBalls :: World -> World +updateEnergyBalls w = w' & energyBalls .~ catMaybes newebs + where + (w',newebs) = mapAccumR moveEnergyBall w $ _energyBalls w + updateSparks :: World -> World updateSparks w = w' & sparks .~ catMaybes newsparks where (w',newsparks) = mapAccumR moveSpark w $ _sparks w +updatePosEvents :: World -> World +updatePosEvents w = w' & posEvents .~ catMaybes newposEvents + where + (w',newposEvents) = mapAccumR updatePosEvent w $ _posEvents w + {- Apply internal particle updates, delete 'Nothing's. -} updateParticles :: World -> World diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index ccc11dfac..53c3900a0 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -8,6 +8,7 @@ module Dodge.WorldEvent.Explosion , makeTeslaExplosionAt ) where import Dodge.Data +import Dodge.EnergyBall import Dodge.LightSource import Dodge.Flame import Dodge.Base.Collide diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index e438ed574..4c45adb00 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -1,10 +1,9 @@ {- | Creation of particles in the world. -} module Dodge.WorldEvent.SpawnParticle ( makeGasCloud - , makeFlamelet - , aStaticBall - , incBall + , makeStaticBall , concBall + , randParticleAt ) where import Dodge.Data import Dodge.Zone @@ -21,6 +20,17 @@ import LensHelp import Data.Foldable import qualified Streaming.Prelude as S +randParticleAt :: (Point2 -> State StdGen Particle) -> Point2 -> World -> World +randParticleAt f p w = w + & instantParticles .:~ thepart + & randGen .~ g + where + (thepart,g) = runState (f p) (_randGen w) + +makeStaticBall :: Point2 -> World -> World +makeStaticBall p = randParticleAt aStaticBall p . (posEvents .:~ thesparker) + where + thesparker = PosEvent SparkSpawner 10 p concBall :: Point2 -> State g Particle concBall p = return Shockwave @@ -34,10 +44,9 @@ concBall p = return Shockwave , _ptTimer = 10 } - aStaticBall :: Point2 -> State g Particle aStaticBall p = return PtStaticBall - { _ptUpdate = moveStaticBall + { _ptUpdate = moveFlamelet , _ptVel = 0 , _ptColor = blue , _ptPos = p @@ -47,48 +56,6 @@ aStaticBall p = return PtStaticBall , _ptZ = 20 } -makeFlamelet - :: Point2 -- ^ Position - -> Float -- ^ z position - -> Point2 -- ^ Velocity - -> Float -- ^ Size - -> Int -- ^ Timer - -> World - -> World -makeFlamelet (V2 x y) z vel size time w = w - & randGen .~ g - & instantParticles .:~ PtIncBall - { _ptUpdate = moveFlamelet - , _ptVel = vel - , _ptColor = red - , _ptPos = V2 x y - , _ptWidth = size - , _ptTimer = time - , _ptHitEff = expireAndDamage $ simpleDam FLAMING 1 - , _ptZ = z - , _ptRot = rot - } - where - (rot ,g) = randomR (0,3) $ _randGen w - ---damageBothTypeAmount :: DamageType --- -> Int --- -> Particle --- -> [(Point2, Either Creature Wall)] --- -> World --- -> (World, Maybe Particle) ---damageBothTypeAmount dt amount = destroyOnImpact --- (\pt p cr -> creatures . ix (_crID cr) . crState . crDamage .:~ thedam pt p) --- (\pt p -> damageWall (thedam pt p)) --- where --- thedam pt p = Damage dt amount sp p ep NoDamageEffect --- where --- sp = _ptPos pt --- ep = sp +.+ _ptVel pt - -moveStaticBall :: World -> Particle -> (World, Maybe Particle) -moveStaticBall = moveFlamelet - -- | Note damgeInRadius by itself never destroys the particle damageInRadius :: Float -> Particle -> World -> World damageInRadius size pt = damageInArea isClose closeWls pt @@ -136,20 +103,6 @@ makeGasCloud pos vel w = w (col, g) = runState (takeOne [green,yellow]) $ _randGen w {- Attach poison cloud damage to creatures near cloud. -} -incBall :: RandomGen g => Point2 -> State g Particle -incBall p = do - rot <- state $ randomR (0,3) - return PtIncBall - { _ptUpdate = moveFlamelet - , _ptVel = 0 - , _ptColor = red - , _ptPos = p - , _ptWidth = 3 - , _ptTimer = 20 - , _ptHitEff = expireAndDamage $ simpleDam FLAMING 1 - , _ptZ = 20 - , _ptRot = rot - } {- Update of a flamelet. Applies movement and attaches damage to nearby creatures. -} diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index 9397d933a..520ed6dc6 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -1,4 +1,4 @@ ---{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TupleSections #-} {- | Find which objects lie upon a line. -} @@ -7,6 +7,8 @@ module Dodge.WorldEvent.ThingsHit , thingHit , thingHitFilt , thingsHitExceptCr + , crsHitRadial + , wlsHitRadial ) where import Dodge.Data @@ -15,6 +17,7 @@ import Dodge.Zone import Geometry --import Data.Maybe +import Data.Functor import Data.Bifunctor import StreamingHelp import qualified Streaming.Prelude as S @@ -66,3 +69,19 @@ wlsHit sp ep | otherwise = sortStreamOn (dist sp . fst) . overlapSegWalls sp ep . wlsNearSeg sp ep + +wlsHitRadial :: Point2 -> Float -> World -> StreamOf (Point2, Wall) +wlsHitRadial p r = S.mapMaybe f . wlsInsideCirc p r + where + f wl = uncurry (intersectSegSeg p (p -.- r *.* v)) (_wlLine wl) <&> (,wl) + where + v = normalizeV $ vNormal $ uncurry (-.-) $ _wlLine wl + +crsHitRadial :: Point2 -> Float -> World -> StreamOf (Point2, Creature) +crsHitRadial p r = S.mapMaybe f . crsInsideCirc p r + where + f cr + | dist cpos p <= r = Just (cpos +.+ r *.* normalizeV (p -.- cpos), cr) + | otherwise = Nothing + where + cpos = _crPos cr