From 29e25f61d3e119587cbd582ff65618d84fd9c898 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 19 Jul 2022 20:38:56 +0100 Subject: [PATCH] Create datatypes for radar sweeps --- src/Dodge/Bullet.hs | 1 - src/Dodge/Data.hs | 12 ++-- src/Dodge/Data/Object.hs | 1 + src/Dodge/Data/RadarSweep.hs | 14 +++++ src/Dodge/Default/World.hs | 1 + src/Dodge/Item/Weapon.hs | 2 - src/Dodge/Item/Weapon/ExtraEffect.hs | 7 +-- src/Dodge/Item/Weapon/Radar.hs | 10 ++-- src/Dodge/Item/Weapon/UseEffect.hs | 86 ---------------------------- src/Dodge/Particle/Draw.hs | 16 ------ src/Dodge/RadarSweep.hs | 77 +++++++++++++++++++++++++ src/Dodge/RadarSweep/Draw.hs | 27 +++++++++ src/Dodge/Render/ShapePicture.hs | 2 + src/Dodge/Update.hs | 6 ++ 14 files changed, 139 insertions(+), 123 deletions(-) create mode 100644 src/Dodge/Data/RadarSweep.hs delete mode 100644 src/Dodge/Item/Weapon/UseEffect.hs create mode 100644 src/Dodge/RadarSweep.hs create mode 100644 src/Dodge/RadarSweep/Draw.hs diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index 8224fb37e..559eab616 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -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 () diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index c217ff52a..1cfa8e31a 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Data/Object.hs b/src/Dodge/Data/Object.hs index 5486e0d44..81ddc997d 100644 --- a/src/Dodge/Data/Object.hs +++ b/src/Dodge/Data/Object.hs @@ -11,4 +11,5 @@ data Object | ObLightSource | ObProp | ObTrigger + | ObItem deriving (Eq,Show,Ord,Read,Enum,Bounded) diff --git a/src/Dodge/Data/RadarSweep.hs b/src/Dodge/Data/RadarSweep.hs new file mode 100644 index 000000000..44a082972 --- /dev/null +++ b/src/Dodge/Data/RadarSweep.hs @@ -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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index b6ab9d876..d68a918c2 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -44,6 +44,7 @@ defaultWorld = World , _instantParticles = [] , _particles = [] , _flames = [] + , _radarSweeps = [] , _sparks = [] , _posEvents = [] , _energyBalls = [] diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 1d4d9a62a..89859f4ad 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 99d23bdae..6f847a386 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/Radar.hs b/src/Dodge/Item/Weapon/Radar.hs index 779958471..68315851f 100644 --- a/src/Dodge/Item/Weapon/Radar.hs +++ b/src/Dodge/Item/Weapon/Radar.hs @@ -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) diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs deleted file mode 100644 index 71eef7850..000000000 --- a/src/Dodge/Item/Weapon/UseEffect.hs +++ /dev/null @@ -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 diff --git a/src/Dodge/Particle/Draw.hs b/src/Dodge/Particle/Draw.hs index 18199edd9..229e088fc 100644 --- a/src/Dodge/Particle/Draw.hs +++ b/src/Dodge/Particle/Draw.hs @@ -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 diff --git a/src/Dodge/RadarSweep.hs b/src/Dodge/RadarSweep.hs new file mode 100644 index 000000000..3422ac0e3 --- /dev/null +++ b/src/Dodge/RadarSweep.hs @@ -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) + diff --git a/src/Dodge/RadarSweep/Draw.hs b/src/Dodge/RadarSweep/Draw.hs new file mode 100644 index 000000000..adc64fd75 --- /dev/null +++ b/src/Dodge/RadarSweep/Draw.hs @@ -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 diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 5b525ff91..e0f1a7274 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -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) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 5e1d9457f..52371f05a 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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