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

Create datatypes for radar sweeps

Browse Source
This commit is contained in:
justin
2022-07-19 20:38:56 +01:00
parent b4c0074d43
commit 29e25f61d3
14 changed files with 139 additions and 123 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Bullet.hs
-1
View File
@@ -116,7 +116,6 @@ damageThingHit bu (p,crwl) = case crwl of
where
dams = setFromToDams bu p
expireAndDamage :: Float
-> Bullet
-> Stream (Of (Point2, Either Creature Wall)) Identity ()
src/Dodge/Data.hs
+4 -8
View File
@@ -10,6 +10,7 @@ circular imports are probably not a good idea.
{-# LANGUAGE DerivingStrategies #-}
module Dodge.Data
( module Dodge.Data
, module Dodge.Data.RadarSweep
, module Dodge.Data.PosEvent
, module Dodge.Data.EnergyBall
, module Dodge.Data.Flame
@@ -52,6 +53,7 @@ module Dodge.Data
, module Dodge.Data.RadarBlip
, module Dodge.Data.PathGraph
) where
import Dodge.Data.RadarSweep
import Dodge.Data.PosEvent
import Dodge.Data.EnergyBall
import Dodge.Data.Flame
@@ -157,6 +159,7 @@ data World = World
, _bullets :: [Bullet]
, _instantParticles :: [Particle]
, _particles :: [Particle]
, _radarSweeps :: [RadarSweep]
, _energyBalls :: [EnergyBall]
, _posEvents :: [PosEvent]
, _flames :: [Flame]
@@ -536,14 +539,7 @@ data BeamType
{- Objects without ids.
Update themselves, perhaps with side effects. -}
data Particle
= RadarCircleParticle
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptTimer :: Int
, _ptRad :: Float
, _ptPos :: Point2
, _ptColor :: Color
}
| LaserParticle
= LaserParticle
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptRange :: Float
, _ptDamage :: Int
src/Dodge/Data/Object.hs
+1
View File
@@ -11,4 +11,5 @@ data Object
| ObLightSource
| ObProp
| ObTrigger
| ObItem
deriving (Eq,Show,Ord,Read,Enum,Bounded)
src/Dodge/Data/RadarSweep.hs
+14
View File
@@ -0,0 +1,14 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.RadarSweep where
import Dodge.Data.Object
import Geometry.Data
import Control.Lens
data RadarSweep = RadarSweep
{ _rsPos :: Point2
, _rsRad :: Float
, _rsObject :: Object
, _rsTimer :: Int
}
makeLenses ''RadarSweep
src/Dodge/Default/World.hs
+1
View File
@@ -44,6 +44,7 @@ defaultWorld = World
, _instantParticles = []
, _particles = []
, _flames = []
, _radarSweeps = []
, _sparks = []
, _posEvents = []
, _energyBalls = []
src/Dodge/Item/Weapon.hs
-2
View File
@@ -5,7 +5,6 @@ module Dodge.Item.Weapon
, module Dodge.Item.Weapon.Shatter
, module Dodge.Item.Weapon.TriggerType
, module Dodge.Item.Weapon.ExtraEffect
, module Dodge.Item.Weapon.UseEffect
, module Dodge.Item.Weapon.Remote
, module Dodge.Item.Weapon.Grenade
, module Dodge.Item.Weapon.Spawn
@@ -23,7 +22,6 @@ import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.SonicGuns
import Dodge.Item.Weapon.Shatter
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.UseEffect
import Dodge.Item.Weapon.Remote
import Dodge.Item.Weapon.Grenade
import Dodge.Item.Weapon.Spawn
src/Dodge/Item/Weapon/ExtraEffect.hs
+3 -4
View File
@@ -17,9 +17,8 @@ module Dodge.Item.Weapon.ExtraEffect
import Dodge.Data
import Dodge.Base
import Dodge.Zone
import Dodge.RadarSweep
import Dodge.SoundLogic
--import Dodge.Item.Weapon.Decoration
import Dodge.Item.Weapon.UseEffect
import Dodge.Item.Weapon.LaserPath
--import Dodge.Item.Attachment.Data
import Dodge.Creature.Test
@@ -49,10 +48,10 @@ autoEffect eff t sid itm cr w
{- | Automatically send out radar pulses that detect walls. -}
autoRadarEffect :: Item -> Creature -> World -> World
autoRadarEffect = autoEffect (const aWallPulse) 100 click1S
autoRadarEffect = autoEffect (const (aRadarPulse ObWall)) 100 click1S
{- | Automatically send out sonar pulses that detect creatures. -}
autoSonarEffect :: Item -> Creature -> World -> World
autoSonarEffect = autoEffect (const aSonarPulse) 50 click1S
autoSonarEffect = autoEffect (const (aRadarPulse ObCreature)) 50 click1S
defaultTargeting :: Targeting
defaultTargeting = Targeting
{ _tgPos = Nothing
src/Dodge/Item/Weapon/Radar.hs
+4 -6
View File
@@ -1,11 +1,9 @@
module Dodge.Item.Weapon.Radar where
import Dodge.Data
--import Dodge.Picture.Layer
import Dodge.RadarSweep
import Dodge.Default
import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.UseEffect
--import Dodge.Item.Weapon.Remote
import Dodge.SoundLogic
import Control.Lens
@@ -34,6 +32,6 @@ autoDetector dt = defaultEquipment
detectorEffect :: Detector -> Item -> Creature -> World -> World
detectorEffect dt = case dt of
ITEMDETECTOR -> const anItemFindPulse
CREATUREDETECTOR -> const aSonarPulse
WALLDETECTOR -> const aWallPulse
ITEMDETECTOR -> const (aRadarPulse ObItem)
CREATUREDETECTOR -> const (aRadarPulse ObCreature)
WALLDETECTOR -> const (aRadarPulse ObWall)
src/Dodge/Item/Weapon/UseEffect.hs
-86
View File
@@ -1,86 +0,0 @@
{- |
Effects centered on creatures.
These are typically item effects, and typical occur when an item is explictly used. -}
module Dodge.Item.Weapon.UseEffect
( anItemFindPulse
, aWallPulse
, aSonarPulse
) where
import Dodge.Data
import Dodge.Zone
import Picture
import Geometry
import LensHelp
import qualified Data.IntMap.Strict as IM
import qualified Streaming.Prelude as S
{- | Creates an outwardly increasing circle that draws creatures, even those behind walls. -}
aSonarPulse :: Creature -> World -> World
aSonarPulse = aRadarPulse crBlips (blipAt 8) (withAlpha 0.2 green)
aWallPulse :: Creature -> World -> World
aWallPulse = aRadarPulse wallBlips (blipAt 2) red
{- | Creates an outwardly increasing circle that displays items. -}
anItemFindPulse :: Creature -> World -> World
anItemFindPulse = aRadarPulse itemBlips (blipAt 6) blue
aRadarPulse :: (Point2 -> Float -> World -> [Point2])
-> (Point2 -> Color -> Int -> RadarBlip)
-> Color
-> Creature
-> World -> World
aRadarPulse blipsF bf col cr = instantParticles .:~ RadarCircleParticle
{ _ptUpdate = mvRadar blipsF bf col (_crPos cr)
, _ptTimer = 100
, _ptRad = 0
, _ptPos = _crPos cr
, _ptColor = col
}
{- | Radar blip at a point. -}
blipAt :: Float -> Point2 -> Color -> Int -> RadarBlip
blipAt r p col i = RadarBlip
{_rbColor = col
,_rbTime = i
,_rbMaxTime = i
,_rbRad = r
,_rbPos = p
}
mvRadar
:: (Point2 -> Float -> World -> [Point2])
-> (Point2 -> Color -> Int -> RadarBlip)
-> Color
-> Point2 -- ^ Center of expanding circle
-> World -> Particle -> (World, Maybe Particle)
mvRadar blipsF bf col p w pt
| x < 1 = (w, Nothing)
| otherwise =
( putBlips w
, Just $ pt & ptRad .~ r & ptTimer .~ (x-1)
)
where
x = _ptTimer pt
putBlips = radarBlips .++~ blips
blips = map (\bp -> bf bp (withAlpha (0.5*globalAlpha) col) 50) circPoints
circPoints = blipsF p r w
r = fromIntegral (400 - x*4)
globalAlpha | x > 10 = 1
| otherwise = fromIntegral x / 10
itemBlips :: Point2 -> Float -> World -> [Point2]
itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems
where
f q = dist p q <= r && dist p q > r - 4
wallBlips :: Point2 -> Float -> World -> [Point2]
wallBlips p r w = runIdentity . S.toList_ $ S.mapMaybe (uncurry (intersectCircSegFirst p r) . _wlLine)
$ S.map (over wlLine swp) (wlsInsideCirc p r w)
<> wlsInsideCirc p r w
where
swp (a,b) = (b,a)
crBlips :: Point2 -> Float -> World -> [Point2]
crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures
where
f q = dist p q <= r && dist p q > r - 100
g cr = _crID cr /= 0
src/Dodge/Particle/Draw.hs
-16
View File
@@ -11,8 +11,6 @@ drawParticle pt = case pt of
PtTargetLaser {} -> drawTargetLaser pt
LaserParticle {} -> drawLaser pt
ShockLine {} -> drawSonicWave pt
RadarCircleParticle {} -> drawPulse pt
drawShockwave :: Particle -> Picture
drawShockwave pt = setDepth 20
@@ -72,17 +70,3 @@ drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDe
. map fst)
$ _ptPointDirs pt
drawPulse :: Particle -> Picture
drawPulse pt = setLayer DebugLayer $ pictures sweepPics
where
col = _ptColor pt
p = _ptPos pt
r = _ptRad pt
sweepPics = [colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
,colHelper 0.06 $ uncurryV translate p $ thickCircle (r-5) 5
,colHelper 0.03 $ uncurryV translate p $ thickCircle (r-10) 5
]
colHelper y = color (withAlpha (y * globalAlpha) col)
globalAlpha | x > 10 = 1
| otherwise = fromIntegral x / 10
x = _ptTimer pt
src/Dodge/RadarSweep.hs
+77
View File
@@ -0,0 +1,77 @@
module Dodge.RadarSweep where
import Dodge.Data
import Dodge.Zone
import Color
import Geometry
import LensHelp
import qualified Data.IntMap.Strict as IM
import qualified Streaming.Prelude as S
aRadarPulse :: Object -> Creature -> World -> World
aRadarPulse ob cr = radarSweeps .:~ RadarSweep
{ _rsTimer = 100
, _rsRad = 0
, _rsPos = _crPos cr
, _rsObject = ob
}
updateRadarSweep
:: World -> RadarSweep -> (World, Maybe RadarSweep)
updateRadarSweep w pt
| x < 1 = (w, Nothing)
| otherwise =
( putBlips w
, Just $ pt & rsRad .~ r & rsTimer .~ (x-1)
)
where
p = _rsPos pt
ob = _rsObject pt
blipsF = findBlips ob
bf = makeBlip ob
x = _rsTimer pt
putBlips = radarBlips .++~ blips
blips = map bf circPoints
circPoints = blipsF p r w
r = fromIntegral (400 - x*4)
findBlips :: Object -> Point2 -> Float -> World -> [Point2]
findBlips ob = case ob of
ObCreature -> crBlips
ObItem -> itemBlips
ObWall -> wallBlips
_ -> undefined
makeBlip :: Object -> Point2 -> RadarBlip
makeBlip ob = case ob of
ObCreature -> blipAt 8 (withAlpha 0.2 green) 50
ObWall -> blipAt 2 red 50
ObItem -> blipAt 6 blue 50
_ -> undefined
{- | Radar blip at a point. -}
blipAt :: Float -> Color -> Int -> Point2 -> RadarBlip
blipAt r col i p = RadarBlip
{_rbColor = col
,_rbTime = i
,_rbMaxTime = i
,_rbRad = r
,_rbPos = p
}
crBlips :: Point2 -> Float -> World -> [Point2]
crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures
where
f q = dist p q <= r && dist p q > r - 100
g cr = _crID cr /= 0
itemBlips :: Point2 -> Float -> World -> [Point2]
itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems
where
f q = dist p q <= r && dist p q > r - 4
wallBlips :: Point2 -> Float -> World -> [Point2]
wallBlips p r w = runIdentity . S.toList_ $ S.mapMaybe (uncurry (intersectCircSegFirst p r) . _wlLine)
$ S.map (over wlLine swp) (wlsInsideCirc p r w)
<> wlsInsideCirc p r w
where
swp (a,b) = (b,a)
src/Dodge/RadarSweep/Draw.hs
+27
View File
@@ -0,0 +1,27 @@
module Dodge.RadarSweep.Draw where
import Dodge.Data.Object
import Dodge.Data.RadarSweep
import Geometry
import Picture
drawRadarSweep :: RadarSweep -> Picture
drawRadarSweep pt = setLayer DebugLayer $ pictures sweepPics
where
col = rsObjectColor $ _rsObject pt
p = _rsPos pt
r = _rsRad pt
sweepPics = [colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
,colHelper 0.06 $ uncurryV translate p $ thickCircle (r-5) 5
,colHelper 0.03 $ uncurryV translate p $ thickCircle (r-10) 5
]
colHelper y = color (withAlpha (y * globalAlpha) col)
globalAlpha | x > 10 = 1
| otherwise = fromIntegral x / 10
x = _rsTimer pt
rsObjectColor :: Object -> Color
rsObjectColor ob = case ob of
ObWall -> red
ObCreature -> green
ObItem -> blue
_ -> yellow
src/Dodge/Render/ShapePicture.hs
+2
View File
@@ -1,6 +1,7 @@
module Dodge.Render.ShapePicture
( worldSPic
) where
import Dodge.RadarSweep.Draw
import Dodge.Item.Draw.SPic
import Dodge.EnergyBall.Draw
import Dodge.Creature.Picture.Awareness
@@ -88,6 +89,7 @@ cullPoint cfig w p
extraPics :: Configuration -> World -> Picture
extraPics cfig w = pictures (_decorations w)
<> concatMapPic drawParticle (_particles w)
<> concatMapPic drawRadarSweep (_radarSweeps w)
<> concatMapPic drawFlame (_flames w)
<> concatMapPic drawEnergyBall (_energyBalls w)
<> concatMapPic drawSpark (_sparks w)
src/Dodge/Update.hs
+6
View File
@@ -5,6 +5,7 @@ Description : Simulation update
-}
module Dodge.Update ( updateUniverse ) where
import Dodge.Data
import Dodge.RadarSweep
import Dodge.PosEvent
import Dodge.Spark
import Dodge.EnergyBall
@@ -86,6 +87,7 @@ functionalUpdate cfig w = checkEndGame
. dbArg _worldEvents
. updateIMl _modifications _mdUpdate
. updateSparks
. updateRadarSweeps
. updatePosEvents
. updateFlames
. updateEnergyBalls
@@ -237,6 +239,10 @@ updateEnergyBalls :: World -> World
updateEnergyBalls w = w' & energyBalls .~ catMaybes newebs
where
(w',newebs) = mapAccumR moveEnergyBall w $ _energyBalls w
updateRadarSweeps :: World -> World
updateRadarSweeps w = w' & radarSweeps .~ catMaybes newradarSweeps
where
(w',newradarSweeps) = mapAccumR updateRadarSweep w $ _radarSweeps w
updateSparks :: World -> World
updateSparks w = w' & sparks .~ catMaybes newsparks