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

Remove dependencies on afterParticles

Browse Source
This commit is contained in:
jgk
2021-03-22 13:22:32 +01:00
parent b50dd8605a
commit 89c6754d1a
3 changed files with 79 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldActions.hs
-90
View File
@@ -268,96 +268,6 @@ tLightRad i rmax rmin p =
tLightAt i p = tLightRad i 100 0 p
flareWidth :: Float -> Float -> Float -> Int -> Color -> Float -> Float -> Point2 -> World -> World
flareWidth len wdth rad rays col ax ay p
= over particles' ((:) (flashRadAt rad col ax p))
. lowLightWidthAt len wdth col ay rays rad p
flareRad :: Float -> Int -> Color -> Float -> Float -> Point2 -> World -> World
flareRad rad rays col ax ay p
= over particles' ((:) (flashRadAt rad col ax p))
. lowLightRadAt col ay rays rad p
flashRadAt :: Float -> Color -> Float -> Point2 -> Particle'
flashRadAt rad col alphax (x,y) =
Particle'
{ _ptPict' = pictures $
map (\i -> onLayerL [levLayer PtLayer]
$ color (withAlpha alphax col) $ translate x y $ circleSolid i
)
[rad/5,2*rad/5,3*rad/5,4*rad/5,rad]
, _ptUpdate' = ptTimer' 1
}
lowLightWidthAt :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> World -> World
lowLightWidthAt len wdth col alphay rays rad p w = foldr (lowLightWidthHit len wdth col alphay p) w ps
where ps = map ((+.+) p) $ nRaysRad rays rad
lowLightRadAt :: Color -> Float -> Int -> Float -> Point2 -> World -> World
lowLightRadAt col alphay rays rad p w = foldr (lowLightColHit col alphay p) w ps
where ps = map ((+.+) p) $ nRaysRad rays rad
lowLightDirected :: Color -> Float -> Point2 -> Point2 -> [Float] -> World -> World
lowLightDirected col alpha a b angles w
= foldr (\angle w' -> lowLightColHit col alpha a (a +.+ rotateV angle b) w') w angles
lowLightWidthHit :: Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World
lowLightWidthHit len wdth col alphay a b w
= case thingsHitLongLine a b w of
((p, E3x2 wall):_)
-> over particles' ((:) (wallGlareWidth len wdth col alphay p wall)) w
((p, E3x1 cr):_)
-> over afterParticles' ((:) (crGlareWidth wdth col alphay p cr)) w
_ -> w
muzFlareAt :: Point2 -> World -> World
muzFlareAt p = over particles' ((:) (muzzleFlareAt p))
. lowLightAt p
muzzleFlareAt :: Point2 -> Particle'
muzzleFlareAt (x,y) =
Particle'
{ _ptPict' = pictures
$ map (\i -> onLayer PtLayer $ color (withAlpha 0.02 white) $ translate x y $ circleSolid i
)
[20,25,30,35,40,45,50]
, _ptUpdate' = ptTimer' 1
}
lowLightAt :: Point2 -> World -> World
lowLightAt p w = lowLightWidthAt 10 5 white 0.5 20 30 p w
lowLightHit :: Point2 -> Point2 -> World -> World
lowLightHit a b w
= case thingsHitLongLine a b w of
((p, E3x2 wall):_)
-> over particles' ((:) (wallGlare p wall)) w
((p, E3x1 cr):_)
-> over afterParticles' ((:) (crGlare p cr)) w
_ -> w
wallGlare :: Point2 -> Wall -> Particle'
wallGlare p wl = wallGlareWidth 10 5 white 0.5 p wl
crGlare :: Point2 -> Creature -> Particle'
crGlare = crGlareCol white 0.5
lowLightAt' :: Point2 -> World -> World
lowLightAt' p w = foldr (lowLightHit' p) w ps
where ps = map ((+.+) p) $ nRaysRad 20 30
lowLightHit' :: Point2 -> Point2 -> World -> World
lowLightHit' a b w
= case thingsHitLongLine a b w of
((p, E3x2 wall):_)
-> over particles' ((:) (wallGlare' p wall)) w
_ -> w
wallGlare' :: Point2 -> Wall -> Particle'
wallGlare' p wl = wallGlareWidth 5 5 white 0.1 p wl
noEff _ _ _ = id
src/Dodge/WorldActions/Bullet.hs
-7
View File
@@ -95,13 +95,6 @@ mvGenBullet' w bt
$ set btTimer' (t-1) bt
)
hits -> hiteff bt hits w
-- hits@((hitp,thing):_)
-- -> ( hiteff bt hits w
-- , Just $ set btPassThrough' Nothing
-- $ set btTrail' (hitp:p:ps)
-- $ set ptPict' (bulLine col wth (hitp:p:ps))
-- $ set btTimer' 3 bt
-- )
where mcr = _btPassThrough' bt
col = _btColor' bt
(p:ps) = _btTrail' bt
src/Dodge/WorldActions/Flash.hs
+79 -5
View File
@@ -24,13 +24,14 @@ lowLightColAt :: Color -> Float -> Point2 -> World -> World
lowLightColAt col alphay p w = foldr (lowLightColHit col alphay p) w ps
where ps = map ((+.+) p) $ nRaysRad 20 30
lowLightColHit :: Color -> Float -> Point2 -> Point2 -> World -> World
lowLightColHit col alphay a b w
= case thingsHitLongLine a b w of
((p, E3x2 wall):_)
-> over particles' ((:) (wallGlareCol col alphay p wall)) w
-> over particles' ((:) (wallGlareWidth 10 5 col alphay p wall)) w
((p, E3x1 cr):_)
-> over afterParticles' ((:) (crGlareCol col alphay p cr)) w
-> over particles' ((:) (crGlareCol col alphay p cr)) w
_ -> w
flashColAt :: Color -> Float -> Point2 -> Particle'
@@ -44,9 +45,6 @@ flashColAt col alphax (x,y) =
, _ptUpdate' = ptTimer' 1
}
wallGlareCol :: Color -> Float -> Point2 -> Wall -> Particle'
wallGlareCol col alphay p wl = wallGlareWidth 10 5 col alphay p wl
crGlareCol :: Color -> Float -> Point2 -> Creature -> Particle'
crGlareCol col alphay p cr = crGlareWidth 5 col alphay p cr
@@ -78,3 +76,79 @@ crGlareWidth wdth col alphay p cr =
upp cid' w' = case w' ^? creatures . ix cid . crPos of
Just y -> l y
_ -> blank
flareWidth :: Float -> Float -> Float -> Int -> Color -> Float -> Float -> Point2 -> World -> World
flareWidth len wdth rad rays col ax ay p
= over particles' ((:) (flashRadAt rad col ax p))
. lowLightWidthAt len wdth col ay rays rad p
flareRad :: Float -> Int -> Color -> Float -> Float -> Point2 -> World -> World
flareRad rad rays col ax ay p
= over particles' ((:) (flashRadAt rad col ax p))
. lowLightRadAt col ay rays rad p
flashRadAt :: Float -> Color -> Float -> Point2 -> Particle'
flashRadAt rad col alphax (x,y) =
Particle'
{ _ptPict' = pictures $
map (\i -> onLayerL [levLayer PtLayer]
$ color (withAlpha alphax col) $ translate x y $ circleSolid i
)
[rad/5,2*rad/5,3*rad/5,4*rad/5,rad]
, _ptUpdate' = ptTimer' 1
}
lowLightWidthAt :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> World -> World
lowLightWidthAt len wdth col alphay rays rad p w = foldr (lowLightWidthHit len wdth col alphay p) w ps
where ps = map ((+.+) p) $ nRaysRad rays rad
lowLightRadAt :: Color -> Float -> Int -> Float -> Point2 -> World -> World
lowLightRadAt col alphay rays rad p w = foldr (lowLightColHit col alphay p) w ps
where ps = map ((+.+) p) $ nRaysRad rays rad
lowLightDirected :: Color -> Float -> Point2 -> Point2 -> [Float] -> World -> World
lowLightDirected col alpha a b angles w
= foldr (\angle w' -> lowLightColHit col alpha a (a +.+ rotateV angle b) w') w angles
lowLightWidthHit :: Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World
lowLightWidthHit len wdth col alphay a b w
= case thingsHitLongLine a b w of
((p, E3x2 wall):_)
-> over particles' ((:) (wallGlareWidth len wdth col alphay p wall)) w
((p, E3x1 cr):_)
-> over afterParticles' ((:) (crGlareWidth wdth col alphay p cr)) w
_ -> w
muzFlareAt :: Point2 -> World -> World
muzFlareAt p = over particles' ((:) (muzzleFlareAt p))
. lowLightAt p
muzzleFlareAt :: Point2 -> Particle'
muzzleFlareAt (x,y) =
Particle'
{ _ptPict' = pictures
$ map (\i -> onLayer PtLayer $ color (withAlpha 0.02 white) $ translate x y $ circleSolid i
)
[20,25,30,35,40,45,50]
, _ptUpdate' = ptTimer' 1
}
lowLightAt :: Point2 -> World -> World
lowLightAt p w = lowLightWidthAt 10 5 white 0.5 20 30 p w
lowLightAt' :: Point2 -> World -> World
lowLightAt' p w = foldr (lowLightHit' p) w ps
where ps = map ((+.+) p) $ nRaysRad 20 30
lowLightHit' :: Point2 -> Point2 -> World -> World
lowLightHit' a b w
= case thingsHitLongLine a b w of
((p, E3x2 wall):_)
-> over particles' ((:) (wallGlare' p wall)) w
_ -> w
wallGlare' :: Point2 -> Wall -> Particle'
wallGlare' p wl = wallGlareWidth 5 5 white 0.1 p wl