Cleanup particles slightly

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)

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 Dodge.GameRoom
-import Geometry
+--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) 
+testStringInit _ = []
-    : (map show . _grBound . last $ sortOn _grName grs) 
+--testStringInit w = (show . _crPos $ _creatures w IM.! 0) 
-    ++ closeRooms
+--    : (map show . _grBound . last $ sortOn _grName grs) 
-  where
+--    ++ closeRooms
-    closeRooms = map _grName $ filter (pointInOrOnPolygon p . _grBound) grs
+--  where
-    grs = _gameRooms w
+--    closeRooms = map _grName $ filter (pointInOrOnPolygon p . _grBound) grs
-    p = _cameraViewFrom w
+--    grs = _gameRooms w
+--    p = _cameraViewFrom w

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) 
+    pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir
-                    +.+ sideOffset *.* vNormal (unitVectorAtAngle dir)
-    (sideOffset,g) = randomR (-5,5) $ _randGen w
     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

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]
+    & menuLayers .~ [WaitMessage "GENERATING..." 1]
-        & worldEvents .~ const aNewGame
+    & worldEvents .~ const aNewGame
   where
     aNewGame :: World
     aNewGame = updateFramebufferSize $ generateLevelFromRoomList levx $ initialWorld 

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

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

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.Config.Data
---import Dodge.Base (halfWidth,halfHeight)
+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
+menuScreen w mLays = case mLays of
-    (LevelMenu x:_) -> optionsFromList w hw hh ("LEVEL"++show x) levelMenuOptions
+    (LevelMenu x:_)     -> optionsFromList w ("LEVEL"++show x) levelMenuOptions
-    (PauseMenu : _) -> optionsFromList w hw hh "PAUSED" pauseMenuOptions
+    (PauseMenu : _)     -> optionsFromList w "PAUSED" pauseMenuOptions
-    (GameOverMenu : _) -> optionsFromList w hw hh "GAME OVER" pauseMenuOptions
+    (GameOverMenu : _)  -> optionsFromList w "GAME OVER" pauseMenuOptions
-    (OptionMenu : _) -> optionsFromList w hw hh "OPTIONS" optionsOptions
+    (OptionMenu : _)    -> optionsFromList w "OPTIONS" optionsOptions
-    (SoundOptionMenu : _) -> optionsFromList w hw hh "OPTIONS:VOLUME" soundMenuOptions
+    (SoundOptionMenu : _) -> optionsFromList w "OPTIONS:VOLUME" soundMenuOptions
-    (GraphicsOptionMenu : _) -> optionsFromList w hw hh "OPTIONS:GRAPHICS" graphicsMenuOptions
+    (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

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)
 

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)

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 :: Color -> Point2 -> Float -> Particle
-makeTeslaArcAt pos dir = LinearParticle
+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
+            & createSparkCol 8 nc q2 (argV sv + d1) Nothing
-        , Just $ pt & ptTimer -~ 1
+        , Just $ pt 
-                            & ptPoints .~ ps'
+            & ptTimer -~ 1
-                            & ptColor .~ theColor)
+            & 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
+    nc = brightX 100 1.5 $ numColor colid
-    theColor = f2 nc
+    (colid,g) = randomR (0::Int,5) $ _randGen w
-    f2 0 = cyan
-    f2 1 = azure
-    f2 _ = white
     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