From fd850938338a979204f393e6356f4b9c92205ee5 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 3 Sep 2021 17:26:21 +0100 Subject: [PATCH] Cleanup particles slightly --- src/Dodge/Data.hs | 13 +----- src/Dodge/Initialisation.hs | 21 +++++----- src/Dodge/Item/Weapon.hs | 12 ++++-- src/Dodge/Menu.hs | 8 +--- src/Dodge/Particle/Bullet/HitEffect.hs | 8 ++-- src/Dodge/Particle/Bullet/Spawn.hs | 6 +-- src/Dodge/Render/MenuScreen.hs | 31 +++++++------- src/Dodge/Render/Picture.hs | 2 +- src/Dodge/WorldEvent.hs | 2 +- src/Dodge/WorldEvent/SpawnParticle.hs | 56 ++++++++------------------ 10 files changed, 64 insertions(+), 95 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index ed11f0127..766bd3a24 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -363,7 +363,7 @@ data Particle , _ptTimer :: Int , _ptColor :: Color } - | Bul' + | BulletPt { _ptDraw :: Particle -> Picture , _ptUpdate' :: World -> Particle -> (World, Maybe Particle) , _btVel' :: Point2 @@ -386,17 +386,6 @@ data Particle , _btHitEffect' :: HitEffect , _ptZ :: Float } - | Pt' - { _ptDraw :: Particle -> Picture - , _ptUpdate' :: World -> Particle -> (World, Maybe Particle) - , _btVel' :: Point2 - , _btColor' :: Color - , _btPos' :: Point2 - , _btPassThrough' :: Maybe Int - , _btWidth' :: Float - , _btTimer' :: Int - , _btHitEffect' :: HitEffect - } | Shockwave' { _ptDraw :: Particle -> Picture , _ptUpdate' :: World -> Particle -> (World, Maybe Particle) diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index c97472528..41e3c84b5 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -11,14 +11,14 @@ import Dodge.WorldEvent.Cloud import Dodge.SoundLogic import Dodge.SoundLogic.Synonyms import Geometry.Data -import Dodge.GameRoom -import Geometry +--import Dodge.GameRoom +--import Geometry import System.Random import qualified Data.Set as S import qualified Data.IntMap.Strict as IM import qualified Data.Map as M -import Data.List (sortOn) +--import Data.List (sortOn) firstWorld :: IO World firstWorld = do @@ -53,10 +53,11 @@ initialWorld = defaultWorld , _worldState = M.empty } testStringInit :: World -> [String] -testStringInit w = (show . _crPos $ _creatures w IM.! 0) - : (map show . _grBound . last $ sortOn _grName grs) - ++ closeRooms - where - closeRooms = map _grName $ filter (pointInOrOnPolygon p . _grBound) grs - grs = _gameRooms w - p = _cameraViewFrom w +testStringInit _ = [] +--testStringInit w = (show . _crPos $ _creatures w IM.! 0) +-- : (map show . _grBound . last $ sortOn _grName grs) +-- ++ closeRooms +-- where +-- closeRooms = map _grName $ filter (pointInOrOnPolygon p . _grBound) grs +-- grs = _gameRooms w +-- p = _cameraViewFrom w diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index ab0b53cab..8393d752f 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -645,12 +645,16 @@ aTeslaArc :: Creature -> World -> World aTeslaArc cr w = teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir) $ set randGen g w - & particles %~ (makeTeslaArcAt pos dir :) + & particles %~ (makeTeslaArcAt col pos dir :) where - pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) - +.+ sideOffset *.* vNormal (unitVectorAtAngle dir) - (sideOffset,g) = randomR (-5,5) $ _randGen w + pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir dir = _crDir cr + (colid,g) = randomR (0::Int,3) $ _randGen w + col = chooseColor colid + chooseColor 0 = white + chooseColor 1 = azure + chooseColor 2 = blue + chooseColor _ = cyan remoteShellPic' :: Projectile -> Picture remoteShellPic' pj diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index a8ea8e086..692ea14c2 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -69,10 +69,6 @@ soundMenuOptions = pushMenu :: MenuLayer -> World -> Maybe World pushMenu ml w' = Just $ w' & menuLayers %~ (ml :) ---soundOptions :: [MenuOption] ---soundOptions = --- [ Toggle2 ScancodeY - graphicsMenuOptions :: [MenuOption] graphicsMenuOptions = [ Toggle ScancodeW (Just . (config . wall_textured %~ not)) wtextstring @@ -100,8 +96,8 @@ pauseMenuOptions = startNewGame :: World -> Maybe World startNewGame w = Just $ w - & menuLayers .~ [WaitMessage "GENERATING..." 1] - & worldEvents .~ const aNewGame + & menuLayers .~ [WaitMessage "GENERATING..." 1] + & worldEvents .~ const aNewGame where aNewGame :: World aNewGame = updateFramebufferSize $ generateLevelFromRoomList levx $ initialWorld diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 13f05f27c..0563e2331 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -135,10 +135,11 @@ bulConCr' bt p cr w {- | Hitting wall effects: create a spark, damage blocks. -} bulHitWall' :: Particle -> Point2 -> Wall -> World -> World bulHitWall' bt p x w = damageBlocksBy 5 x - $ createSpark 8 12 pOut (reflectDir x) Nothing + $ createSparkCol 8 theCol pOut (reflectDir x) Nothing $ set randGen g w where + theCol = brightX 100 1.5 white sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) (a, g) = randomR (-0.2,0.2) $ _randGen w @@ -197,10 +198,11 @@ hvBulHitWall' bt p x w = damageBlocksBy 5 x $ set randGen g $ foldr ($) w (spar reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) ) sv = unitVectorAtAngle $ reflectDir x - cs = take 10 $ randomRs (0,11) $ _randGen w + cs' = take 10 $ randomRs (0,11) $ _randGen w + cs = map (brightX 100 1.5 . numColor) cs' ds = randomRs (-0.7,0.7) $ _randGen w ts = randomRs (4,8) $ _randGen w - sparks pos vel = zipWith3 (\t c d -> createSpark t c pos (argV vel + d) Nothing) ts cs ds + sparks pos vel = zipWith3 (\t c d -> createSparkCol t c pos (argV vel + d) Nothing) ts cs ds bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World bulHitFF' _ _ _ = id diff --git a/src/Dodge/Particle/Bullet/Spawn.hs b/src/Dodge/Particle/Bullet/Spawn.hs index 2275669c8..071663a1f 100644 --- a/src/Dodge/Particle/Bullet/Spawn.hs +++ b/src/Dodge/Particle/Bullet/Spawn.hs @@ -16,7 +16,7 @@ aGenBulAt -> HitEffect -> Float -- ^ Bullet width -> Particle -aGenBulAt maycid pos vel hiteff width = Bul' +aGenBulAt maycid pos vel hiteff width = BulletPt { _ptDraw = drawBul , _ptUpdate' = mvGenBullet , _btVel' = vel @@ -35,7 +35,7 @@ aDelayedBulAt -> HitEffect -> Float -- ^ Bullet width -> Particle -aDelayedBulAt vfact maycid pos vel hiteff width = Bul' +aDelayedBulAt vfact maycid pos vel hiteff width = BulletPt { _ptDraw = drawBul , _ptUpdate' = \w -> resetVel . mvGenBullet w , _btVel' = vfact *.* vel @@ -58,7 +58,7 @@ aCurveBulAt -> HitEffect -> Float -- ^ Bullet width -> Particle -aCurveBulAt maycid col pos control targ hiteff width = Bul' +aCurveBulAt maycid col pos control targ hiteff width = BulletPt { _ptDraw = drawBul , _ptUpdate' = \w -> mvGenBullet w . setVel , _btVel' = V2 0 0 diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index ee2aa0c4b..79140d06c 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -8,8 +8,8 @@ module Dodge.Render.MenuScreen import Dodge.Data.Menu import Dodge.Data --import Dodge.Config.Update -import Dodge.Config.Data ---import Dodge.Base (halfWidth,halfHeight) +--import Dodge.Config.Data +import Dodge.Base.Window import Picture import Geometry import Dodge.Menu @@ -17,18 +17,15 @@ import Dodge.Menu menuScreen :: World - -> Configuration - -> Float -- Half width of screen - -> Float -- Half height of screen -> [MenuLayer] -> Picture -menuScreen w cfig hw hh mLays = case mLays of - (LevelMenu x:_) -> optionsFromList w hw hh ("LEVEL"++show x) levelMenuOptions - (PauseMenu : _) -> optionsFromList w hw hh "PAUSED" pauseMenuOptions - (GameOverMenu : _) -> optionsFromList w hw hh "GAME OVER" pauseMenuOptions - (OptionMenu : _) -> optionsFromList w hw hh "OPTIONS" optionsOptions - (SoundOptionMenu : _) -> optionsFromList w hw hh "OPTIONS:VOLUME" soundMenuOptions - (GraphicsOptionMenu : _) -> optionsFromList w hw hh "OPTIONS:GRAPHICS" graphicsMenuOptions +menuScreen w mLays = case mLays of + (LevelMenu x:_) -> optionsFromList w ("LEVEL"++show x) levelMenuOptions + (PauseMenu : _) -> optionsFromList w "PAUSED" pauseMenuOptions + (GameOverMenu : _) -> optionsFromList w "GAME OVER" pauseMenuOptions + (OptionMenu : _) -> optionsFromList w "OPTIONS" optionsOptions + (SoundOptionMenu : _) -> optionsFromList w "OPTIONS:VOLUME" soundMenuOptions + (GraphicsOptionMenu : _) -> optionsFromList w "OPTIONS:GRAPHICS" graphicsMenuOptions (ControlList : _) -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh ,tst (-100) 100 0.4 "CONTROLS" @@ -40,6 +37,8 @@ menuScreen w cfig hw hh mLays = case mLays of _ -> blank where tst x y sc t = translate x y $ scale sc sc $ color white $ text t + hh = halfHeight w + hw = halfWidth w displayStringList :: Float -> Float -> [String] -> Picture displayStringList hw hh ss = pictures @@ -52,12 +51,10 @@ displayStringList hw hh ss = pictures optionsFromList :: World - -> Float -- ^ Half screen width - -> Float -- ^ Half screen height -> String -- ^ Title -> [MenuOption] -- ^ Options -> Picture -optionsFromList w hw hh tit ops = pictures $ +optionsFromList w title ops = pictures $ [darkenBackground ,theTitle] ++ @@ -68,7 +65,9 @@ optionsFromList w hw hh tit ops = pictures $ notInvisible _ = True placeString x y sc t = translate x y $ scale sc sc $ color white $ text t darkenBackground = color (withAlpha 0.5 black) $ polygon $ screenBox hw hh - theTitle = placeString (-hw + 30) (hh - 50) 0.4 tit + theTitle = placeString (-hw + 30) (hh - 50) 0.4 title + hh = halfHeight w + hw = halfWidth w menuOptionToString :: World -> MenuOption -> String menuOptionToString w mo@(Toggle{}) = (scodeToChar $ _moKey mo) : ':' : _moString mo w diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 329a11ece..c9b25ceac 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -50,7 +50,7 @@ fixedCoordPictures w = case _menuLayers w of [ hudDrawings w , customMouseCursor w ] - lays -> scaler . onLayer MenuDepth $ menuScreen w (_config w) (halfWidth w) (halfHeight w) lays + lays -> scaler . onLayer MenuDepth $ menuScreen w lays where scaler = setDepth (-1) . scale (2 / getWindowX w) (2 / getWindowY w) diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 7e37d175d..3bcceeca4 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -33,7 +33,7 @@ createBarrelSpark :: Point2 -> Float -> Maybe Int -> Int -> Int -> World -> Worl createBarrelSpark pos dir maycid time colid w = over worldEvents (( over particles (spark :) . sparkFlashAt pos') . ) w where - spark = Bul' + spark = BulletPt { _ptDraw = drawBul , _ptUpdate' = mvGenBullet , _btVel' = rotateV dir (V2 5 0) diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 67ed4f0b4..7f39cb2e4 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -14,7 +14,7 @@ import Dodge.Picture import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.Cloud -import Dodge.WorldEvent.Flash +--import Dodge.WorldEvent.Flash import Dodge.Particle.Bullet.Draw import Dodge.Particle.Bullet.Update import Dodge.SoundLogic @@ -41,7 +41,7 @@ aFlameParticle -> Point2 -- ^ Velocity -> Maybe Int -- ^ Creature id -> Particle -aFlameParticle t pos vel maycid = Pt' +aFlameParticle t pos vel maycid = PtZ { _ptDraw = drawFlame vel , _ptUpdate' = moveFlame vel , _btVel' = vel @@ -51,10 +51,12 @@ aFlameParticle t pos vel maycid = Pt' , _btWidth' = 4 , _btTimer' = t , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff + , _ptZ = 20 } drawFlame :: Point2 -- ^ Rotate direction - -> Particle -> Picture + -> Particle + -> Picture drawFlame rotd pt = thePic where ep = _btPos' pt @@ -300,13 +302,13 @@ cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedC damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (stripZ $ _clPos c) w f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10 doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1) -makeTeslaArcAt :: Point2 -> Float -> Particle -makeTeslaArcAt pos dir = LinearParticle +makeTeslaArcAt :: Color -> Point2 -> Float -> Particle +makeTeslaArcAt col pos dir = LinearParticle { _ptPoints = [pos] , _ptDraw = drawTeslaArc , _ptUpdate' = moveTeslaArc pos dir , _ptTimer = 2 - , _ptColor = white + , _ptColor = brightX 100 1.5 col } drawTeslaArc :: Particle -> Picture drawTeslaArc pt = pic @@ -328,10 +330,11 @@ moveTeslaArc moveTeslaArc p d w pt | t == 2 = (foldr damCrs w hitCrs & randGen .~ g - & createSpark 8 nc q2 (argV sv + d1) Nothing - , Just $ pt & ptTimer -~ 1 - & ptPoints .~ ps' - & ptColor .~ theColor) + & createSparkCol 8 nc q2 (argV sv + d1) Nothing + , Just $ pt + & ptTimer -~ 1 + & ptPoints .~ ps' + ) | t < 1 = (w , Nothing) | otherwise = (w , Just $ pt & ptTimer -~ 1) where @@ -342,11 +345,8 @@ moveTeslaArc p d w pt f (E3x3 p1) = p1 ps' = lightningMids d pers ps pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w - (nc,g) = randomR (0::Int,5) $ _randGen w - theColor = f2 nc - f2 0 = cyan - f2 1 = azure - f2 _ = white + nc = brightX 100 1.5 $ numColor colid + (colid,g) = randomR (0::Int,5) $ _randGen w f1 (E3x1 cr) = Just $ _crID cr f1 _ = Nothing hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w @@ -453,32 +453,11 @@ crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0)) -- | Create a spark. -- If the spark is created by another Particle, it cannot be directly added to -- the list, hence the redirect through worldEvents. -createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World -createSpark time colid pos dir maycid w - = w & worldEvents %~ ( (over particles (spark :) . sparkFlashAt pos') . ) - where - spark = Bul' - { _ptDraw = drawBul - , _ptUpdate' = mvGenBullet - , _btVel' = rotateV dir (V2 5 0) - , _btColor' = brightX 100 1.5 $ numColor colid - , _btTrail' = [pos] - , _btPassThrough' = maycid - , _btWidth' = 1 - , _btTimer' = time - , _btHitEffect' = destroyOnImpact sparkEff noEff noEff - } - pos' = pos +.+ rotateV dir (V2 5 0) - sparkEff bt p cr - = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : ) - where - sp = head (_btTrail' bt) - ep = sp +.+ _btVel' bt createSparkCol :: Int -> Color -> Point2 -> Float -> Maybe Int -> World -> World createSparkCol time col pos dir maycid w - = w & worldEvents %~ ( (over particles (spark :) . sparkFlashAt pos') . ) + = w & worldEvents %~ ( over particles (spark :) . ) where - spark = Bul' + spark = BulletPt { _ptDraw = drawBul , _ptUpdate' = mvGenBullet , _btVel' = rotateV dir (V2 5 0) @@ -489,7 +468,6 @@ createSparkCol time col pos dir maycid w , _btTimer' = time , _btHitEffect' = destroyOnImpact sparkEff noEff noEff } - pos' = pos +.+ rotateV dir (V2 5 0) sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : ) where