diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 02642d44c..24f7fbabd 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -32,8 +32,10 @@ module Dodge.Data , module Dodge.Data.ItemAmount , module Dodge.RoomCluster.Data , module Dodge.Data.Room + , module Dodge.Data.RadarBlip , module Dodge.Data.PathGraph ) where +import Dodge.Data.RadarBlip import Dodge.Data.Room import Dodge.Data.PathGraph import Dodge.Data.Zoning @@ -119,6 +121,7 @@ data World = World , _props :: IM.IntMap Prop , _instantParticles :: [Particle] , _particles :: [Particle] + , _radarBlips :: [RadarBlip] , _newBeams :: WorldBeams , _beams :: WorldBeams , _walls :: IM.IntMap Wall @@ -636,15 +639,6 @@ data Particle { _ptDraw :: Particle -> Picture , _ptUpdate :: World -> Particle -> (World, Maybe Particle) } - | BlipParticle - { _ptDraw :: Particle -> Picture - , _ptColor :: Color - , _ptTimer :: Int - , _ptMaxTime :: Int - , _ptUpdate :: World -> Particle -> (World, Maybe Particle) - , _ptRad :: Float - , _ptPos :: Point2 - } | RadarCircleParticle { _ptDraw :: Particle -> Picture , _ptUpdate :: World -> Particle -> (World, Maybe Particle) @@ -661,6 +655,19 @@ data Particle , _ptPhaseV :: Float , _ptPoints :: [Point2] } + | PtTeslaArc + { _ptDraw :: Particle -> Picture + , _ptUpdate :: World -> Particle -> (World, Maybe Particle) + , _ptPoints :: [Point2] + , _ptTimer :: Int + , _ptColor :: Color + } + | PtTargetLaser + { _ptDraw :: Particle -> Picture + , _ptUpdate :: World -> Particle -> (World, Maybe Particle) + , _ptPoints :: [Point2] + , _ptColor :: Color + } | LinearParticle { _ptDraw :: Particle -> Picture , _ptUpdate :: World -> Particle -> (World, Maybe Particle) @@ -680,6 +687,58 @@ data Particle , _ptTimer :: Int , _ptHitEff :: HitEffect } + | PtFlame + { _ptDraw :: Particle -> Picture + , _ptUpdate :: World -> Particle -> (World, Maybe Particle) + , _ptVel :: Point2 + , _ptColor :: Color + , _ptPos :: Point2 + , _ptCrIgnore :: Maybe Int + , _ptWidth :: Float + , _ptTimer :: Int + , _ptHitEff :: HitEffect + , _ptZ :: Float + , _ptOriginalVel :: Point2 + } + | PtIncBall + { _ptDraw :: Particle -> Picture + , _ptUpdate :: World -> Particle -> (World, Maybe Particle) + , _ptVel :: Point2 + , _ptColor :: Color + , _ptPos :: Point2 + , _ptCrIgnore :: Maybe Int + , _ptWidth :: Float + , _ptTimer :: Int + , _ptHitEff :: HitEffect + , _ptZ :: Float + , _ptRot :: Float + } + | PtStaticBall + { _ptDraw :: Particle -> Picture + , _ptUpdate :: World -> Particle -> (World, Maybe Particle) + , _ptVel :: Point2 + , _ptColor :: Color + , _ptPos :: Point2 + , _ptCrIgnore :: Maybe Int + , _ptWidth :: Float + , _ptTimer :: Int + , _ptHitEff :: HitEffect + , _ptZ :: Float + } + | PtMuzFlare + { _ptDraw :: Particle -> Picture + , _ptUpdate :: World -> Particle -> (World, Maybe Particle) + , _ptPoly :: [Point2] + , _ptColor :: Color + , _ptTran3 :: Point3 + } + | PtCircFlare + { _ptDraw :: Particle -> Picture + , _ptUpdate :: World -> Particle -> (World, Maybe Particle) + , _ptColor :: Color + , _ptAlpha :: Float + , _ptTran3 :: Point3 + } | PtZ { _ptDraw :: Particle -> Picture , _ptUpdate :: World -> Particle -> (World, Maybe Particle) @@ -703,6 +762,17 @@ data Particle , _ptMaxTime :: Int , _ptTimer :: Int } + | PtInvShockwave + { _ptDraw :: Particle -> Picture + , _ptUpdate :: World -> Particle -> (World, Maybe Particle) + , _ptColor :: Color + , _ptPos :: Point2 + , _ptRad :: Float + , _ptDam :: Int + , _ptPush :: Float + , _ptMaxTime :: Int + , _ptTimer :: Int + } | ShockLine { _ptDraw :: Particle -> Picture , _ptUpdate :: World -> Particle -> (World, Maybe Particle) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index ab8f716b5..7ae1b5ecb 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -44,6 +44,7 @@ defaultWorld = World , _props = IM.empty , _instantParticles = [] , _particles = [] + , _radarBlips = [] , _newBeams = WorldBeams [] [] [] [] , _beams = WorldBeams [] [] [] [] , _walls = IM.empty diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs index ca93814ff..3561aaefe 100644 --- a/src/Dodge/Item/Weapon/UseEffect.hs +++ b/src/Dodge/Item/Weapon/UseEffect.hs @@ -23,10 +23,10 @@ aWallPulse = aRadarPulse wallBlips (blipAt 2) red {- | Creates an outwardly increasing circle that displays items. -} anItemFindPulse :: Creature -> World -> World -anItemFindPulse = aRadarPulse itemBlips (openBlipAt 6) blue +anItemFindPulse = aRadarPulse itemBlips (blipAt 6) blue aRadarPulse :: (Point2 -> Float -> World -> [Point2]) - -> (Point2 -> Color -> Int -> Particle) + -> (Point2 -> Color -> Int -> RadarBlip) -> Color -> Creature -> World -> World @@ -51,70 +51,17 @@ drawPulse col pt = setLayer DebugLayer $ pictures sweepPics | otherwise = fromIntegral x / 10 x = _ptTimer pt {- | Radar blip at a point. -} -blipAt :: Float -> Point2 -> Color -> Int -> Particle -blipAt r p col i = BlipParticle - {_ptDraw = drawBlip - ,_ptUpdate = \w pt -> if _ptTimer pt <= 0 then (w,Nothing) else (w,Just $ pt & ptTimer -~ 1) - ,_ptColor = col - ,_ptTimer = i - ,_ptMaxTime = i - ,_ptRad = r - ,_ptPos = p +blipAt :: Float -> Point2 -> Color -> Int -> RadarBlip +blipAt r p col i = RadarBlip + {_rbColor = col + ,_rbTime = i + ,_rbMaxTime = i + ,_rbRad = r + ,_rbPos = p } -drawBlip :: Particle -> Picture -drawBlip pt = setDepth (-0.5) - . setLayer DebugLayer - . uncurryV translate p - . color (withAlpha (fromIntegral t / fromIntegral maxt) col) - $ circleSolid r - where - p = _ptPos pt - t = _ptTimer pt - r = _ptRad pt - col = _ptColor pt - maxt = _ptMaxTime pt -mvBlip :: Float - -> Point2 -> Color - -> Int -- ^ Max possible timer value - -> Int -- ^ Current timer value - -> World -> Particle -> (World, Maybe Particle) -mvBlip r p col maxt t w pt = case t of - 0 -> (w, Nothing) - _ -> (w - , Just $ pt & ptUpdate .~ mvBlip r p col maxt (t-1) - & ptDraw .~ ( const - . setDepth (-0.5) - . setLayer DebugLayer - . uncurryV translate p - . color (withAlpha (fromIntegral t / fromIntegral maxt) col) - $ circleSolid r ) - ) -{- | Radar blip at a point. -} -openBlipAt :: Float -> Point2 -> Color -> Int -> Particle -openBlipAt r p col i = Particle - {_ptDraw = const blank - ,_ptUpdate = mvOpenBlip r p col i i - } -mvOpenBlip :: Float - -> Point2 -> Color - -> Int -- ^ Max possible timer value - -> Int -- ^ Current timer value - -> World -> Particle -> (World, Maybe Particle) -mvOpenBlip r p col maxt t w pt = case t of - 0 -> (w, Nothing) - _ -> (w - , Just $ pt & ptUpdate .~ mvOpenBlip r p col maxt (t-1) - & ptDraw .~ ( const - . setDepth (-0.5) - . setLayer DebugLayer - . uncurryV translate p - . color (withAlpha (fromIntegral t / fromIntegral maxt) col) - $ thickCircle r 3) - ) - mvRadar :: (Point2 -> Float -> World -> [Point2]) - -> (Point2 -> Color -> Int -> Particle) + -> (Point2 -> Color -> Int -> RadarBlip) -> Color -> Point2 -- ^ Center of expanding circle -> World -> Particle -> (World, Maybe Particle) @@ -126,7 +73,7 @@ mvRadar blipsF bf col p w pt ) where x = _ptTimer pt - putBlips = over worldEvents ( over instantParticles (blips ++) . ) + 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) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 982b1d35a..d4b427258 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.Creature.Picture.Awareness +import Dodge.RadarBlip import Dodge.ShortShow import Dodge.Config.Data import Dodge.Render.InfoBox @@ -81,6 +82,7 @@ cullPoint cfig w p extraPics :: Configuration -> World -> Picture extraPics cfig w = pictures (_decorations w) <> concatMapPic (dbArg _ptDraw) (_particles w) + <> concatMapPic drawBlip (_radarBlips w) <> concatMapPic (dbArg _bmDraw) (_positronBeams $ _beams w) <> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w) <> concatMapPic (dbArg _lsPict) (_lightSources w) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 276676dad..8a275a976 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.RadarBlip import Dodge.Menu import Dodge.CullBox --import Dodge.Block @@ -47,6 +48,7 @@ updateUniverse u = case _menuLayers u of | otherwise -> u & menuLayers %~ ( (WaitScreen s (i-1) :) . tail ) (OptionScreen {_scOptionFlag = GameOverOptions} : _) -> u & uvWorld %~ ( updateParticles + . (radarBlips .~ []) . updateIMl _props _pjUpdate . updateLightSources . updateClouds ) @@ -75,6 +77,7 @@ functionalUpdate cfig w = checkEndGame . dbArg _worldEvents . updateIMl _modifications _mdUpdate . updateParticles + . updateRadarBlips . updateBeams . updateIMl _props _pjUpdate . updateLightSources @@ -199,6 +202,9 @@ updateLightSources w = over tempLightSources f w where f = mapMaybe (\b -> _tlsUpdate b w b) +updateRadarBlips :: World -> World +updateRadarBlips = radarBlips %~ mapMaybe updateRadarBlip + {- Apply internal particle updates, delete 'Nothing's. -} updateParticles :: World -> World updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w' diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 5e4b5ccd7..dbbac1463 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -33,7 +33,7 @@ aFlameParticle -> Point2 -- ^ Velocity -> Maybe Int -- ^ Creature id -> Particle -aFlameParticle t pos vel maycid = PtZ +aFlameParticle t pos vel maycid = PtFlame { _ptDraw = drawFlame vel , _ptUpdate = moveFlame vel , _ptVel = vel @@ -44,6 +44,7 @@ aFlameParticle t pos vel maycid = PtZ , _ptTimer = t , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20 , _ptZ = 20 + , _ptOriginalVel = vel } drawFlame :: Point2 -- ^ Rotate direction