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

Move radar blips into own grouping

Browse Source
This commit is contained in:
justin
2022-07-10 11:52:51 +01:00
parent 8202d12b6a
commit ce5b596d4f
6 changed files with 101 additions and 74 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+79 -9
View File
@@ -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)
src/Dodge/Default/World.hs
+1
View File
@@ -44,6 +44,7 @@ defaultWorld = World
, _props = IM.empty
, _instantParticles = []
, _particles = []
, _radarBlips = []
, _newBeams = WorldBeams [] [] [] []
, _beams = WorldBeams [] [] [] []
, _walls = IM.empty
src/Dodge/Item/Weapon/UseEffect.hs
+11 -64
View File
@@ -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)
src/Dodge/Render/ShapePicture.hs
+2
View File
@@ -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)
src/Dodge/Update.hs
+6
View File
@@ -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'
src/Dodge/WorldEvent/SpawnParticle.hs
+2 -1
View File
@@ -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