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

Improve static bullets

Browse Source
This commit is contained in:
justin
2022-07-19 13:15:13 +01:00
parent 54ba0fbedc
commit 0a7922ec5e
19 changed files with 287 additions and 134 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Bullet.hs
+20 -11
View File
@@ -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 ()
src/Dodge/Creature.hs
+2
View File
@@ -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 ]
src/Dodge/Creature/State.hs
+1 -1
View File
@@ -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
src/Dodge/DamageCircle.hs
+29
View File
@@ -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
src/Dodge/Data.hs
+6 -11
View File
@@ -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
src/Dodge/Data/Bullet.hs
+2 -2
View File
@@ -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
src/Dodge/Data/EnergyBall.hs
+19
View File
@@ -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
src/Dodge/Data/PosEvent.hs
+14
View File
@@ -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
src/Dodge/Default/World.hs
+2
View File
@@ -45,6 +45,8 @@ defaultWorld = World
, _particles = []
, _flames = []
, _sparks = []
, _posEvents = []
, _energyBalls = []
, _radarBlips = []
, _flares = []
, _newBeams = WorldBeams [] [] [] []
src/Dodge/EnergyBall.hs
+63
View File
@@ -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
src/Dodge/EnergyBall/Draw.hs
+52
View File
@@ -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
src/Dodge/Item/Weapon/Launcher.hs
+1 -2
View File
@@ -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
src/Dodge/Particle/Draw.hs
-45
View File
@@ -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
src/Dodge/PosEvent.hs
+25
View File
@@ -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)
src/Dodge/Render/ShapePicture.hs
+2
View File
@@ -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)
src/Dodge/Update.hs
+14
View File
@@ -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
src/Dodge/WorldEvent/Explosion.hs
+1
View File
@@ -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
src/Dodge/WorldEvent/SpawnParticle.hs
+14 -61
View File
@@ -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. -}
src/Dodge/WorldEvent/ThingsHit.hs
+20 -1
View File
@@ -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