From 8dd6379d8ec3a0d4b887d5138221df444229fc45 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 31 Oct 2021 13:34:22 +0000 Subject: [PATCH] Cleanup --- src/Dodge/Item/Weapon.hs | 5 -- src/Dodge/Item/Weapon/Laser.hs | 2 +- src/Dodge/LightSources/Lamp.hs | 4 +- src/Dodge/WorldEvent/Cloud.hs | 18 +++--- src/Dodge/WorldEvent/DamageBlock.hs | 3 +- src/Dodge/WorldEvent/Explosion.hs | 6 +- src/Dodge/WorldEvent/Flash.hs | 45 ++------------- src/Dodge/WorldEvent/HitEffect.hs | 90 ++++++++++++++--------------- 8 files changed, 68 insertions(+), 105 deletions(-) diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 044e80c5b..20927b347 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -798,11 +798,6 @@ moveRemoteBomb itid time pID w updatePicture = set (props . ix pID . prDraw) (\_ -> (,) mempty $ onLayer PtLayer $ uncurryV translate newPos $ remoteBombPic time) - . lowLightDirected - (withAlpha 0.1 red) - newPos - (50 *.* unitVectorAtAngle (negate $ degToRad (10 * fromIntegral time))) - [-0.2,-0.15,-0.1,-0.05,0,0.05,0.1,0.15,0.2] setRemoteBombScope :: Int -> Prop -> World -> World diff --git a/src/Dodge/Item/Weapon/Laser.hs b/src/Dodge/Item/Weapon/Laser.hs index 389c04558..e2bb55fca 100644 --- a/src/Dodge/Item/Weapon/Laser.hs +++ b/src/Dodge/Item/Weapon/Laser.hs @@ -25,7 +25,7 @@ import qualified Data.Sequence as Seq --import qualified Data.IntMap.Strict as IM aLaser :: Creature -> World -> World -aLaser cr w = over particles (makeLaserAt phaseV pos dir : ) w +aLaser cr = particles %~ (makeLaserAt phaseV pos dir : ) where pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) dir = _crDir cr diff --git a/src/Dodge/LightSources/Lamp.hs b/src/Dodge/LightSources/Lamp.hs index 070b948d5..8b0e848d4 100644 --- a/src/Dodge/LightSources/Lamp.hs +++ b/src/Dodge/LightSources/Lamp.hs @@ -30,9 +30,9 @@ colorLightAt col pos i = ,_lsPict = lightSourcePicture } lightSourcePicture :: LightSource -> Picture -lightSourcePicture ls = setLayer 1 . translate3 (_lsPos ls) . color col $ circleSolid 3 +lightSourcePicture ls = setLayer 1 . translate3 (_lsPos ls) . color col $ circleSolid 4 where - col = V4 r g b 1 + col = V4 r g b 2 V3 r g b = _lsIntensity ls lightAt :: Point3 -> Int -> LightSource diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index 646618cb4..a1582acaf 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -1,11 +1,16 @@ module Dodge.WorldEvent.Cloud - where - + ( makeFlamerSmokeAt + , smokeCloudAt + , makeThinSmokeAt + , makeThickSmokeAt + , shellTrailCloud + , spawnSmokeAtCursor + , makeStartCloudAt + ) where import Dodge.Data import Dodge.Base import Geometry.Data import Picture ---import qualified IntMapHelp as IM import Control.Lens @@ -17,7 +22,7 @@ makeCloudAt -> Point3 -- start position -> World -> World -makeCloudAt drawFunc rad t alt p w = w & clouds %~ (theCloud :) +makeCloudAt drawFunc rad t alt p = clouds %~ (theCloud :) where theCloud = Cloud { _clPos = p @@ -41,8 +46,7 @@ smokeCloudAt smokeCloudAt col = makeCloudAt (drawCloudWith (4/3) 800 col) drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture -drawCloudWith radMult fadet col cl - = setLayer 2 +drawCloudWith radMult fadet col cl = setLayer 2 . setDepth 25 $ circleSolidCol (withAlpha 0 col) (withAlpha a col) (radMult * _clRad cl) where @@ -55,11 +59,9 @@ makeThinSmokeAt :: Point3 -> World -> World makeThinSmokeAt = makeCloudAt (drawCloudWith 4 400 (withAlpha 0.05 black)) 5 400 50 makeStartCloudAt :: Point3 -> World -> World ---makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5)) makeStartCloudAt = makeCloudAt (drawCloudWith 2 800 white) 10 400 5 shellTrailCloud :: Point3 -> World -> World -----makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5)) shellTrailCloud = makeCloudAt (drawCloudWith (4/3) 800 (greyN 0.5)) 15 400 40 makeFlamerSmokeAt :: Float -> Point3 -> World -> World diff --git a/src/Dodge/WorldEvent/DamageBlock.hs b/src/Dodge/WorldEvent/DamageBlock.hs index 8c3666186..0ae0e301c 100644 --- a/src/Dodge/WorldEvent/DamageBlock.hs +++ b/src/Dodge/WorldEvent/DamageBlock.hs @@ -1,5 +1,6 @@ module Dodge.WorldEvent.DamageBlock - where + ( damageBlocksBy + ) where import Dodge.Data import Control.Lens diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index a503adbb6..7e334c2cc 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -2,7 +2,11 @@ Explosions: creation of shockwave and particles at a given point. -} module Dodge.WorldEvent.Explosion - where + ( makeExplosionAt + , makeFlameExplosionAt + , makePoisonExplosionAt + , makeTeslaExplosionAt + ) where import Dodge.Data import Dodge.Data.SoundOrigin import Dodge.Default diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 6d34e7abc..296701b37 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -13,21 +13,15 @@ module Dodge.WorldEvent.Flash , explosionFlashAt , laserGunFlashAt , teslaGunFlashAt - , lowLightDirected - , flareCircleAt , muzFlareAt ) where import Dodge.Data ---import Dodge.Base -import Dodge.Picture import Dodge.LightSources.Lamp -import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.HelperParticle import Picture import Geometry -import Data.Maybe (maybeToList) import Control.Lens import System.Random @@ -39,37 +33,10 @@ teslaGunFlashAt = flareCircleAt cyan 0.7 laserGunFlashAt :: Point3 -> World -> World laserGunFlashAt = flareCircleAt yellow 0.2 -glareLine' :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> World -glareLine' t len wdth col a b w = w & particles %~ (maybeToList linePt ++) - where - linePt :: Maybe Particle - linePt = glareBetween t len wdth col a b w - -glareBetween :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> Maybe Particle -glareBetween 0 _ _ _ _ _ _ = Nothing -glareBetween t len wdth col a b w = Just $ Particle - {_ptDraw = const $ lowLightPic len wdth col (a,b) w - ,_ptUpdate = \ w' _ -> (w',glareBetween (t-1) len wdth col a b w') - } - -lowLightPic :: Float -> Float -> Color -> (Point2, Point2) -> World -> Picture -lowLightPic len wdth col (a,b) w = case thingsHit a b w of - ((p, E3x2 wall):_) - -> setCol . lineOfThickness wdth $ [alongSegBy len p wa, alongSegBy len p wb] - where - (wa,wb) = _wlLine wall - ((p, E3x1 cr):_) - -> setCol . uncurryV translate cp . rotate (-0.25 * pi + argV (p -.- cp)) - $ thickArc 0 (pi/2) (_crRad cr) wdth - where - cp = _crPos cr - _ -> blank - where setCol = color col . setDepth (-0.5) . setLayer 2 - muzFlareAt :: Color -> Point3 -> Float -> World -> World -muzFlareAt col tranv dir w = w & particles %~ (theFlareCircle :) +muzFlareAt col tranv dir w = w & particles %~ (theFlare :) where - theFlareCircle = Particle + theFlare = Particle { _ptDraw = const $ setLayer 1 . translate3 tranv $ theShape , _ptUpdate = ptSimpleTime 2 } @@ -84,21 +51,17 @@ flareCircleAt :: Color -> Float -> Point3 -> World -> World flareCircleAt col alphax tranv = particles %~ (theFlareCircle :) where theFlareCircle = Particle - { _ptDraw = const $ setLayer 2 . translate3 tranv + { _ptDraw = const . setLayer 1 . translate3 tranv $ circleSolidCol (withAlpha alphax col) (withAlpha 0 col) 30 , _ptUpdate = ptSimpleTime 1 } explosionFlashAt :: Point2 -> World -> World -explosionFlashAt p = over tempLightSources ((:) $ tLightTimedIntensity 20 150 intensityFunc p) +explosionFlashAt p = tempLightSources %~ (tLightTimedIntensity 20 150 intensityFunc p :) where intensityFunc x | x < 10 = 1 / (10 - fromIntegral x) | otherwise = 1 -lowLightDirected :: Color -> Point2 -> Point2 -> [Float] -> World -> World -lowLightDirected col a b angles w - = foldr (\angle w' -> glareLine' 2 10 5 col a (a +.+ rotateV angle b) w') w angles - sparkFlashAt :: Point2 -> World -> World sparkFlashAt _ = id diff --git a/src/Dodge/WorldEvent/HitEffect.hs b/src/Dodge/WorldEvent/HitEffect.hs index 396dc1bcf..724cbd238 100644 --- a/src/Dodge/WorldEvent/HitEffect.hs +++ b/src/Dodge/WorldEvent/HitEffect.hs @@ -1,4 +1,9 @@ module Dodge.WorldEvent.HitEffect + ( destroyOnImpact + , doFlameDam + , noEff + , penWalls + ) where import Dodge.Data import Dodge.Data.DamageType @@ -13,21 +18,21 @@ type HitCreatureEffect = Particle -> Point2 -> Creature -> World -> World type HitWallEffect = Particle -> Point2 -> Wall -> World -> World type HitForceFieldEffect = Particle -> Point2 -> ForceField -> World -> World -passThroughAll - :: HitCreatureEffect - -> HitWallEffect - -> HitForceFieldEffect - -> Particle - -> [(Point2, Either3 Creature Wall ForceField)] -- ^ hit things - -> World - -> (World, Maybe Particle) -passThroughAll _ _ _ pt _ w = (w, mvPt) - where - mvPt = Just $ pt & btTrail' .~ (newP : trl) - & btTimer' %~ (\t -> t - 1) - & btPassThrough' .~ Nothing - trl = _btTrail' pt - newP = head trl +.+ _btVel' pt +--passThroughAll +-- :: HitCreatureEffect +-- -> HitWallEffect +-- -> HitForceFieldEffect +-- -> Particle +-- -> [(Point2, Either3 Creature Wall ForceField)] -- ^ hit things +-- -> World +-- -> (World, Maybe Particle) +--passThroughAll _ _ _ pt _ w = (w, mvPt) +-- where +-- mvPt = Just $ pt & btTrail' .~ (newP : trl) +-- & btTimer' %~ (\t -> t - 1) +-- & btPassThrough' .~ Nothing +-- trl = _btTrail' pt +-- newP = head trl +.+ _btVel' pt destroyOnImpact :: HitCreatureEffect @@ -38,20 +43,23 @@ destroyOnImpact -> World -> (World, Maybe Particle) destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of - [] -> ( w, mvPt) - ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p) - ((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) - & btTimer' .~ 3 - mvPt = Just $ pt - & btTrail' .~ (newP : trl) - & btTimer' %~ (\t -> t - 1) - & btPassThrough' .~ Nothing - trl = _btTrail' pt - newP = head trl +.+ _btVel' pt + [] -> ( w, mvPt pt) + ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt) + ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p pt) + ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt) + +mvPt :: Particle -> Maybe Particle +mvPt pt = Just $ pt + & btTrail' %~ f + & btTimer' -~ 1 + & btPassThrough' .~ Nothing + where + f trl = head trl +.+ _btVel' pt : trl + +destroyAt :: Point2 -> Particle -> Maybe Particle +destroyAt hitp pt = Just $ pt + & btTrail' %~ (hitp :) + & btTimer' %~ (\t -> min 3 (t-1)) penWalls :: HitCreatureEffect @@ -62,26 +70,16 @@ penWalls -> World -> (World, Maybe Particle) penWalls crEff wlEff ffEff pt hitThings w = case hitThings of - [] -> ( w, mvPt) - ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p) - ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p) + [] -> ( w, mvPt pt) + ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt) + ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt) ((p,E3x2 wl):hs) | isJust (wl ^? wlBlockID) - -> 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) - & btTimer' .~ 3 - mvPt = Just $ pt - & btTrail' .~ (newP : trl) - & btTimer' %~ (\t -> t - 1) - & btPassThrough' .~ Nothing - trl = _btTrail' pt - newP = head trl +.+ _btVel' pt + -> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w + ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p pt) doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World -doFlameDam amount pt p cr = over (creatures . ix (_crID cr) . crState . crDamage) - ((:) $ Flaming amount sp p ep) +doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage %~ + (Flaming amount sp p ep :) where sp = _btPos' pt ep = sp +.+ _btVel' pt