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

Replace particle pictures with draw functions

Browse Source
This commit is contained in:
justin
2021-03-24 13:42:31 +01:00
parent 27fc9d19d2
commit 3cce959d00
8 changed files with 70 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEvent/Bullet.hs
-40
View File
@@ -21,21 +21,18 @@ mvBulletTrajectory velF w bt
| t <= 0 = (w, Nothing)
| t < 4 = (w, Just $ set btPassThrough' Nothing
$ set btTrail' (replicate numPs p ++ (p:ps) )
$ set ptPict' (bulLineLen numPs col wth (replicate numPs p ++ (p:ps) ) )
$ set btTimer' (t-1)
bt
)
| otherwise = (w, Just $ set btPassThrough' Nothing
$ set btVel' newVel -- this may be useful for hit effects
$ set btTrail' (init (reverse newPs) ++ (p:ps))
$ set ptPict' (bulLineLen numPs col wth (init (reverse newPs) ++ (p:ps)))
$ set btTimer' (t-1) bt
)
-- | otherwise = case firstThingHit $ thingsHitExceptCrCurve mcr (p:newPs) w of
-- (_,Nothing) -> (w, Just $ set btPassThrough' Nothing
-- $ set btVel' newVel -- this may be useful for hit effects
-- $ set btTrail' (init (reverse newPs) ++ (p:ps))
-- $ set ptPict' (bulLineLen numPs col wth (init (reverse newPs) ++ (p:ps)))
-- $ set btTimer' (t-1) bt
-- )
-- (mvPs,Just (hitp,thing))
@@ -46,7 +43,6 @@ mvBulletTrajectory velF w bt
-- , Just $ set btPassThrough' Nothing
-- $ set btVel' hitVel -- this may be useful for hit effects
-- $ set btTrail' (newMvPs ++ (p:ps))
-- $ set ptPict' (bulLineLen numPs col wth (newMvPs ++ (p:ps)) )
-- $ set btTimer' 3 bt
-- )
where mcr = _btPassThrough' bt
@@ -85,7 +81,6 @@ mvGenBullet' w bt
| t <= 0 = (w, Nothing)
| t < 4 = (w, Just $ set btPassThrough' Nothing
$ set btTrail' (p:p:ps)
$ set ptPict' (bulLine col wth (p:p:ps))
$ set btTimer' (t-1) bt
)
| otherwise = hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
@@ -97,38 +92,3 @@ mvGenBullet' w bt
wth = _btWidth' bt
t = _btTimer' bt
bulLineLen :: Int -> Color -> Float -> [Point2] -> Picture
bulLineLen n c w ps =
setLayer 1 . onLayer HPtLayer $ color c $ thickLine (take (n * 2) ps) w
bulLine c w = setLayer 1 . bulLineb w
bulLineb :: Float -> [Point2] -> Picture
bulLineb w ps = color white $ thickLine (take 2 ps) w
bulLinea :: Color -> Float -> [Point2] -> Picture
bulLinea _ _ [] = blank
bulLinea _ _ (x:[]) = blank
bulLinea col width (a:b:[]) -- (a:b:[])
= onLayer HPtLayer $ pictures $ reverse
[polygonCol $ zip (wedgeGeom width b a) $ [white,withAlpha 0 white,withAlpha 0 white]
,polygonCol $ zip (lineGeom (width+1.5) a b) $ [col,col,withAlpha 0 col,withAlpha 0 col]
]
bulLinea col width (a:b:c:[]) -- (a:b:[])
= onLayer HPtLayer $ pictures $ reverse
[polygonCol $ zip (wedgeGeom width b a) $ repeat white
,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
]
bulLinea col width (a:b:_:c:[]) -- (a:b:[])
= onLayer HPtLayer $ pictures $ reverse
[polygonCol $ zip (wedgeGeom width b a) $ repeat white
,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
]
bulLinea col width (a:b:_:_:c:_) -- (a:b:[])
= onLayer HPtLayer $ pictures $ reverse
[polygonCol $ zip (wedgeGeom width b a) $ repeat white
,polygonCol $ zip (wedgeGeom width b c) $ [white,white,withAlpha 0 white]
,polygonCol $ zip (lineGeom (width+1.5) a c) $ [col,col,withAlpha 0 col,withAlpha 0 col]
]
src/Dodge/WorldEvent/Flash.hs
+3 -3
View File
@@ -55,7 +55,7 @@ glareLine t len wdth col alphay a b w = w & particles' %~ (maybeToList linePt ++
glareBetween :: Int -> Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> Maybe Particle'
glareBetween 0 _ _ _ _ _ _ _ = Nothing
glareBetween t len wdth col alphay a b w
= Just $ Particle' {_ptPict' = lowLightPic len wdth col alphay a b w
= Just $ Particle' {_ptDraw = const $ lowLightPic len wdth col alphay a b w
,_ptUpdate' = \ w' _ -> (w',glareBetween (t-1) len wdth col alphay a b w')
}
@@ -76,7 +76,7 @@ lowLightPic len wdth col alphay a b w
flashFlareAt :: Color -> Float -> Point2 -> Particle'
flashFlareAt col alphax (x,y) =
Particle'
{ _ptPict' = setLayer 2 . setDepth (-0.9) . translate x y
{ _ptDraw = const $ setLayer 2 . setDepth (-0.9) . translate x y
$ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
, _ptUpdate' = ptTimer' 1
}
@@ -102,7 +102,7 @@ muzzleFlashAt p = over particles' ((:) (muzzleFlashPt p))
muzzleFlashPt :: Point2 -> Particle'
muzzleFlashPt (x,y) =
Particle'
{ _ptPict' = setDepth 0
{ _ptDraw = const $ setDepth 0
. setLayer 2
. translate x y
$ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
src/Dodge/WorldEvent/Projectile.hs
-7
View File
@@ -22,10 +22,8 @@ destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ drawBul wth (hitp: trl)
& btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ drawBul wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
@@ -41,15 +39,10 @@ penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
-> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
((p,E3x2 wl):_) | otherwise -> (wlEff pt p wl w, destroyAt p)
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
& ptPict' .~ drawBul wth (hitp: trl)
& btTimer' .~ 3
mvPt = Just $ pt & btTrail' .~ (newP : trl)
& ptPict' .~ drawBul wth (newP : trl)
& btTimer' %~ (\t -> t - 1)
& btPassThrough' .~ Nothing
trl = _btTrail' pt
wth = _btWidth' pt
newP = head trl +.+ _btVel' pt
drawBul :: Float -> [Point2] -> Picture
drawBul width (a:b:_) = setLayer 1 . color white $ thickLine [a,b] width
drawBul _ _ = blank