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

Move radar blips into own grouping, work on data-ifying particles

Browse Source
This commit is contained in:
justin
2022-07-10 12:38:32 +01:00
parent ce5b596d4f
commit 23022d85a1
10 changed files with 290 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+25 -24
View File
@@ -635,16 +635,17 @@ data BeamType
{- Objects without ids.
Update themselves, perhaps with side effects. -}
data Particle
= Particle
{ _ptDraw :: Particle -> Picture
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
}
| RadarCircleParticle
-- = Particle
-- { _ptDraw :: Particle -> Picture
-- , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-- }
= RadarCircleParticle
{ _ptDraw :: Particle -> Picture
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptTimer :: Int
, _ptRad :: Float
, _ptPos :: Point2
, _ptColor :: Color
}
| LaserParticle
{ _ptDraw :: Particle -> Picture
@@ -668,13 +669,13 @@ data Particle
, _ptPoints :: [Point2]
, _ptColor :: Color
}
| LinearParticle
{ _ptDraw :: Particle -> Picture
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptPoints :: [Point2]
, _ptTimer :: Int
, _ptColor :: Color
}
-- | LinearParticle
-- { _ptDraw :: Particle -> Picture
-- , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-- , _ptPoints :: [Point2]
-- , _ptTimer :: Int
-- , _ptColor :: Color
-- }
| BulletPt
{ _ptDraw :: Particle -> Picture
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
@@ -739,18 +740,18 @@ data Particle
, _ptAlpha :: Float
, _ptTran3 :: Point3
}
| PtZ
{ _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
}
-- | PtZ
-- { _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
-- }
| Shockwave
{ _ptDraw :: Particle -> Picture
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
src/Dodge/Data/RadarBlip.hs
+16
View File
@@ -0,0 +1,16 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.RadarBlip where
import Color
import Geometry
import Control.Lens
data RadarBlip = RadarBlip
{ _rbColor :: Color
, _rbTime :: Int
, _rbMaxTime :: Int
, _rbRad :: Float
, _rbPos :: Point2
}
makeLenses ''RadarBlip
src/Dodge/Item/Weapon/Decoration.hs
+4 -1
View File
@@ -14,14 +14,17 @@ makeLaserScope
-> Point2 -- ^ End point
-> Float -- ^ Fraction of red/green
-> Particle
makeLaserScope p ep relFrac = Particle
makeLaserScope p ep relFrac = PtTargetLaser
{_ptDraw = const $ setLayer BloomLayer $ setDepth 20 $ pictures
[lineAlphaThick 0.5 0.5
,lineAlphaThick 0.2 1.5
,lineAlphaThick 0.1 2
]
,_ptUpdate = \w pt -> (w, Just $ pt & ptUpdate .~ \w' _ -> (w',Nothing))
, _ptPoints = [p,ep]
, _ptColor = col
}
where
lineAlphaThick a w =
color (withAlpha a $ mixColors relFrac (1-relFrac) red green) $ thickLine w [p,ep]
col = mixColors relFrac (1-relFrac) red green
src/Dodge/Item/Weapon/ExtraEffect.hs
+3 -1
View File
@@ -198,12 +198,14 @@ targetLaserUpdate _ cr w t
(mp, ps) = reflectLaserAlong 0.2 sp ep w
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
addLaserPic = instantParticles .:~ Particle
addLaserPic = instantParticles .:~ PtTargetLaser
{ _ptDraw = const $ setLayer BloomNoZWrite $ pictures
[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 5 (sp:ps)
, setDepth 19.5 . color (brightX 5 1 col) $ thickLine 1 (sp:ps)
]
, _ptUpdate = ptSimpleTime 1
, _ptPoints = (sp:ps)
, _ptColor = col
}
--wpammo = _itConsumption it
-- reloadFrac
src/Dodge/Item/Weapon/UseEffect.hs
+1
View File
@@ -36,6 +36,7 @@ aRadarPulse blipsF bf col cr = instantParticles .:~ RadarCircleParticle
, _ptTimer = 100
, _ptRad = 0
, _ptPos = _crPos cr
, _ptColor = col
}
drawPulse :: Color -> Particle -> Picture
drawPulse col pt = setLayer DebugLayer $ pictures sweepPics
src/Dodge/Particle/Draw.hs
+200
View File
@@ -0,0 +1,200 @@
module Dodge.Particle.Draw where
import Dodge.Data
import Geometry
import Picture
drawParticle :: Particle -> Picture
drawParticle pt = case pt of
PtFlame {} -> drawFlame pt
Shockwave {} -> drawShockwave pt
PtStaticBall {} -> drawStaticBall pt
PtIncBall {} -> drawFlameletZ pt
PtMuzFlare {} -> drawMuzFlare pt
PtCircFlare {} -> drawCircFlare pt
PtInvShockwave {} -> drawInverseShockwave pt
BulletPt {} -> drawBul pt
PtTeslaArc {} -> drawTeslaArc pt
PtTargetLaser {} -> drawTargetLaser pt
LaserParticle {} -> drawLaser pt
ShockLine {} -> drawSonicWave pt
RadarCircleParticle {} -> drawPulse pt
drawFlame
:: Particle
-> Picture
drawFlame pt = pictures
[ glow
, aPic BloomNoZWrite prot2 25 (V2 (scaleChange + 1) 2 ) $ V4 2 (-1) (-1) 0.5
, aPic BloomNoZWrite prot 22 (V2 (scaleChange + 0.5) 1 ) $ V4 1 0.5 0 2
, aPic BloomLayer prot3 20 (V2 scaleChange 0.5) $ V4 1 1 1 1
]
where
rotd = _ptOriginalVel pt -- rotate direction
ep = _ptPos pt
aPic :: Layer -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
aPic lay offset depth (V2 scalex scaley) col
= setLayer lay
. setDepth depth
. uncurryV translate (offset ep)
. rotate (pi * 0.5 + argV rotd)
. scale scalex scaley
. color col
$ circleSolid 5
glow = setLayer BloomNoZWrite $ setDepth 0.3 $ uncurryV translate ep
$ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
time = _ptTimer pt
scaleChange
| time < 80 = 3
| otherwise = 3 - (fromIntegral time - 80) * 0.2
prot p' = p' +.+ rotateV (fromIntegral time) (V2 0 1)
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (V2 0 1)
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (V2 0 2)
drawShockwave :: Particle -> Picture
drawShockwave pt = setDepth 20
. setLayer BloomLayer
. uncurryV translate (_ptPos pt)
. color (_ptColor pt)
$ thickCircle rad thickness
where
r = _ptRad pt
thickness = tFraction**2 * r
rad = r - (3/4) * r * tFraction
tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt)
drawStaticBall
:: Particle
-> Picture
drawStaticBall pt = setLayer BloomNoZWrite
. setDepth (_ptZ pt + 20)
. 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
drawMuzFlare :: Particle -> Picture
drawMuzFlare pt = setLayer BloomNoZWrite . translate3 tranv $ theShape
where
tranv = _ptTran3 pt
col = _ptColor pt
poly = _ptPoly pt
theShape = color col $ polygon poly
drawCircFlare :: Particle -> Picture
drawCircFlare pt = setLayer BloomNoZWrite . translate3 tranv
$ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50
where
col = _ptColor pt
tranv = _ptTran3 pt
alphax = _ptAlpha pt
drawInverseShockwave :: Particle -> Picture
drawInverseShockwave pt
= setLayer BloomLayer $ setDepth 20 $ uncurryV translate p
$ color cyan $ thickCircle rad thickness
where
p = _ptPos pt
r = _ptRad pt
t = _ptTimer pt
rad = r - 0.1 * r * fromIntegral (10 - t)
thickness = fromIntegral (10 - t) **2 * rad / 40
drawBul :: Particle -> Picture
drawBul pt = setLayer BloomNoZWrite
. setDepth 20
. color (_ptColor pt)
-- $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)
$ thickLine (_ptWidth pt) (take 2 $ _ptTrail pt)
drawTeslaArc :: Particle -> Picture
drawTeslaArc pt = setLayer BloomNoZWrite $ pictures
[ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ thickLine 3 ps
, setDepth 20 $ color (V4 0 0 0 0.5) $ thickLine 10 ps
]
where
ps = _ptPoints pt
drawTargetLaser :: Particle -> Picture
drawTargetLaser pt = setLayer BloomNoZWrite $ pictures
[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 5 (sp:ps)
, setDepth 19.5 . color (brightX 5 1 col) $ thickLine 1 (sp:ps)
]
where
col = _ptColor pt
(sp:ps) = _ptPoints pt
drawLaser :: Particle -> Picture
--drawLaser pt = setLayer BloomNoZWrite $ pictures
--[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 ps
drawLaser pt =
setLayer BloomNoZWrite $ pictures
-- [ setDepth 19 . color (brightX 1 0.5 col) $ thickLine 20 ps
[ setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps
]
where
col = _ptColor pt
ps = _ptPoints pt
drawSonicWave :: Particle -> Picture
drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20
. lineThick 20
. 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/Particle/TeslaArc.hs
+1 -1
View File
@@ -20,7 +20,7 @@ import LensHelp
--import Data.Maybe
aTeslaArcAt :: Color -> [ArcStep] -> Particle
aTeslaArcAt col thearc = LinearParticle
aTeslaArcAt col thearc = PtTeslaArc
{ _ptPoints = map (^. asPos) thearc
, _ptDraw = drawTeslaArc
, _ptUpdate = moveTeslaArc thearc
src/Dodge/RadarBlip.hs
+23
View File
@@ -0,0 +1,23 @@
module Dodge.RadarBlip where
import Dodge.Data.RadarBlip
import Geometry.Data
import LensHelp
import Picture
updateRadarBlip :: RadarBlip -> Maybe RadarBlip
updateRadarBlip rb
| _rbTime rb <= 0 = Nothing
| otherwise = Just $ rb & rbTime -~ 1
drawBlip :: RadarBlip -> Picture
drawBlip pt = setDepth (-0.5)
. setLayer DebugLayer
. uncurryV translate p
. color (withAlpha (fromIntegral t / fromIntegral maxt) col)
$ circleSolid r
where
p = _rbPos pt
t = _rbTime pt
r = _rbRad pt
col = _rbColor pt
maxt = _rbMaxTime pt
src/Dodge/WorldEvent/Flash.hs
+12 -2
View File
@@ -25,9 +25,16 @@ import LensHelp
import System.Random
muzFlareAt :: Color -> Point3 -> Float -> World -> World
muzFlareAt col tranv dir w = w & instantParticles .:~ Particle
muzFlareAt col tranv dir w = w & instantParticles .:~ PtMuzFlare
{ _ptDraw = const $ setLayer BloomNoZWrite . translate3 tranv $ theShape
, _ptUpdate = ptSimpleTime 2
, _ptPoly =
[ V2 0 0
, V2 a (-b)
, V2 c d
]
, _ptColor = col
, _ptTran3 = tranv
}
where
theShape = rotate dir . color col $ polygon
@@ -38,10 +45,13 @@ muzFlareAt col tranv dir w = w & instantParticles .:~ Particle
(a:b:c:d:_) = randomRs (2,20) (_randGen w)
flareCircleAt :: Color -> Float -> Point3 -> World -> World
flareCircleAt col alphax tranv = instantParticles .:~ Particle
flareCircleAt col alphax tranv = instantParticles .:~ PtCircFlare
{ _ptDraw = const . setLayer BloomNoZWrite . translate3 tranv
$ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50
, _ptUpdate = ptSimpleTime 1
, _ptColor = col
, _ptAlpha = alphax
, _ptTran3 = tranv
}
explosionFlashAt :: Point2 -> World -> World
src/Dodge/WorldEvent/SpawnParticle.hs
+5 -3
View File
@@ -129,7 +129,7 @@ concBall p = return Shockwave
aStaticBall :: Point2 -> State g Particle
aStaticBall p = return PtZ
aStaticBall p = return PtStaticBall
{ _ptDraw = drawStaticBall
, _ptUpdate = moveStaticBall
, _ptVel = 0
@@ -153,7 +153,7 @@ makeFlamelet
-> World
makeFlamelet (V2 x y) z vel maycid size time w = w
& randGen .~ g
& instantParticles .:~ PtZ
& instantParticles .:~ PtIncBall
{ _ptDraw = drawFlameletZ rot
, _ptUpdate = moveFlamelet
, _ptVel = vel
@@ -164,6 +164,7 @@ makeFlamelet (V2 x y) z vel maycid size time w = w
, _ptTimer = time
, _ptHitEff = expireAndDamage $ simpleDam FLAMING 20
, _ptZ = z
, _ptRot = rot
}
where
(rot ,g) = randomR (0,3) $ _randGen w
@@ -255,7 +256,7 @@ cloudPoisonDamage c w = w & dodamagesto (S.filter f $ crsNearPoint clpos w)
incBall :: RandomGen g => Point2 -> State g Particle
incBall p = do
rot <- state $ randomR (0,3)
return PtZ
return PtIncBall
{ _ptDraw = drawFlameletZ rot
, _ptUpdate = moveFlamelet
, _ptVel = 0
@@ -266,6 +267,7 @@ incBall p = do
, _ptTimer = 20
, _ptHitEff = expireAndDamage $ simpleDam FLAMING 20
, _ptZ = 20
, _ptRot = rot
}
drawFlameletZ
:: Float -- ^ Rotation