From 89c6754d1aa0990b9939048f1b037e6f80eb4a7d Mon Sep 17 00:00:00 2001 From: jgk Date: Mon, 22 Mar 2021 13:22:32 +0100 Subject: [PATCH] Remove dependencies on afterParticles --- src/Dodge/WorldActions.hs | 90 -------------------------------- src/Dodge/WorldActions/Bullet.hs | 7 --- src/Dodge/WorldActions/Flash.hs | 84 +++++++++++++++++++++++++++-- 3 files changed, 79 insertions(+), 102 deletions(-) diff --git a/src/Dodge/WorldActions.hs b/src/Dodge/WorldActions.hs index 046084101..c481ad747 100644 --- a/src/Dodge/WorldActions.hs +++ b/src/Dodge/WorldActions.hs @@ -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 diff --git a/src/Dodge/WorldActions/Bullet.hs b/src/Dodge/WorldActions/Bullet.hs index 5da51acb2..214ba1b00 100644 --- a/src/Dodge/WorldActions/Bullet.hs +++ b/src/Dodge/WorldActions/Bullet.hs @@ -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 diff --git a/src/Dodge/WorldActions/Flash.hs b/src/Dodge/WorldActions/Flash.hs index abaa79568..a47465cc3 100644 --- a/src/Dodge/WorldActions/Flash.hs +++ b/src/Dodge/WorldActions/Flash.hs @@ -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