Cleanup. Start tweaking flares, glares and flashes

src/Dodge/Event.hs

@@ -59,7 +59,7 @@ handleMouseButtonEvent mbev w = case mouseButtonEventMotion mbev of
   where 
     but = mouseButtonEventButton mbev
 
-{- | Sets window position in config.  -}
+{- | Sets window position in config. -}
 handleWindowMoveEvent :: WindowMovedEventData -> World -> Maybe World
 handleWindowMoveEvent mev w = Just $ w 
     & config . windowPosX .~ fromIntegral x
@@ -67,7 +67,7 @@ handleWindowMoveEvent mev w = Just $ w
   where
     P (V2 x y) = windowMovedEventPosition mev
 
-{- | Resets the world window size, and resizes the fbo that gets the light map drawn into it.  -}
+{- | Resets the world window size, and resizes the fbo that gets the light map drawn into it. -}
 handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
 handleResizeEvent sev w = Just 
     . set (config . windowX) (fromIntegral x)

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -10,7 +10,6 @@ import Dodge.Item.Data
 import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.UseEffect
 import Dodge.Item.Attachment.Data
-import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.ThingsHit
 import Dodge.Picture.Layer
 import Dodge.Creature.Test
@@ -52,6 +51,7 @@ bezierRecock = ItInvEffect
                   _          -> it & itAttachment .~ NoItAttachment
 {- |
 Creates a laser scope and recocks the weapon.
+TODO add the laser scope!
  -}
 itemLaserScopeEffect :: ItEffect
 itemLaserScopeEffect 
@@ -63,7 +63,6 @@ itemLaserScopeEffect
         | invid == _crInvSel cr && crIsAiming' cr = w 
             & particles %~ (:) (makeLaserScope sp ep reloadFrac)
             & creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp
-            & laserScopeTargetGlow col glowPoint 
         | otherwise = w
       where
         p = _crPos cr
@@ -74,14 +73,14 @@ itemLaserScopeEffect
         ep = case listToMaybe $ thingsHitLongLine sp xp w of
                 Just (pos,_) -> pos
                 Nothing -> xp
-        glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of
-                Just (pos,E3x2 wl) -> pos +.+ 2 *.* wallNormal wl
-                _ -> ep -.- 2 *.* unitVectorAtAngle d
+        --glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of
+        --        Just (pos,E3x2 wl) -> pos +.+ 2 *.* wallNormal wl
+        --        _ -> ep -.- 2 *.* unitVectorAtAngle d
         it = (cr ^. crInv) IM.! invid
         reloadFrac 
             | _wpLoadedAmmo it == 0 = 1
             | otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it)
-        col = mixColors reloadFrac (1-reloadFrac) red green
+        --col = mixColors reloadFrac (1-reloadFrac) red green
 {- | Automatically send out radar pulses that detect walls.  -}
 autoRadarEffect :: ItEffect
 autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -30,7 +30,7 @@ bulHitCr :: Particle -> Point2 -> Creature -> World -> World
 bulHitCr bt p cr w 
     | crIsArmouredFrom p cr
         = createSparkCol 8 colID p1 (argV (p1 -.- p) + d1) . addDamageArmoured $ w
-    | otherwise = addDamage . makeHitSound . flashEff $ w
+    | otherwise = addDamage . makeHitSound $ w
   where
     sp = head $ _btTrail' bt
     bulVel = _btVel' bt
@@ -39,7 +39,6 @@ bulHitCr bt p cr w
     addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
     addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
     makeHitSound = soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
-    flashEff = over worldEvents (bloodFlashAt p . )
     cid = _crID cr
     (d1,_)  = randomR (-0.7,0.7) $ _randGen w
     colID = _btColor' bt
@@ -48,7 +47,7 @@ bulHitCr bt p cr w
 bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
 bulBounceArmCr' bt p cr w 
     | crIsArmouredFrom p cr = addBouncer . addDamageArmoured $ w
-    | otherwise = addDamage . makeHitSound . flashEff $ w
+    | otherwise = addDamage . makeHitSound $ w
   where
     sp = head $ _btTrail' bt
     bulVel = _btVel' bt
@@ -57,7 +56,6 @@ bulBounceArmCr' bt p cr w
     addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
     addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
     makeHitSound = soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
-    flashEff = over worldEvents ((.) $ bloodFlashAt p)
     cid = _crID cr
     newDir = safeNormalizeV (p -.- _crPos cr)
     pOut = p +.+ 2 *.* newDir

src/Dodge/WorldEvent.hs

@@ -12,19 +12,15 @@ import Dodge.Particle.Bullet.Draw
 import Dodge.Particle.Bullet.Update
 import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.ThingsHit
---import Dodge.WorldEvent.HelperParticle
 import Dodge.WorldEvent.Cloud
 import Dodge.WorldEvent.HitEffect
 import Dodge.WorldEvent.Explosion
 import Dodge.WorldEvent.SpawnParticle
---import Dodge.WorldEvent.Shockwave
 import Dodge.LightSources.Lamp
 import Dodge.Creature.State.Data
 import Dodge.Data
 import Dodge.Data.DamageType
---import Dodge.Base
 import Geometry
---import Picture
 
 import Control.Lens
 import System.Random

src/Dodge/WorldEvent/Flash.hs

@@ -1,14 +1,20 @@
 {- | Flashes.
 projected naming conventions: three base types of light:
-glare : "low lighting", draws lines around creatures and walls
-flare : coloured light drawn on top of picture in fixed shapes
-light : removal of shadows
+glare : Draws color onto surfaces (not done)
+flare : coloured light drawn in space, fixed shapes
+light : removal of shadows (onto surfaces)
 duration (subject to modification):
 flash   : short, abrupt changes in alpha
 glow    : continuous, potentially long, fading, slow changes in alpha
 flicker : potentially long, moving, abrupt changes in alpha
 -}
 module Dodge.WorldEvent.Flash
+    ( sparkFlashAt
+    , explosionFlashAt
+    , laserGunFlashAt
+    , teslaGunFlashAt
+    , lowLightDirected
+    )
     where
 import Dodge.Data
 --import Dodge.Base
@@ -22,33 +28,13 @@ import Geometry
 import Data.Maybe (maybeToList)
 import Control.Lens
 
-glareAt :: Int -> Float -> Float -> Color -> Int -> Float -> Point2 -> World -> World
-glareAt t len wdth col nrays rad p w = foldr (glareLine' t len wdth col p) w ps
-  where 
-    ps = map (p +.+) $ nRaysRad nrays rad
-
-{- White flash. -}
-sparkFlashAt :: Point2 -> World -> World
-sparkFlashAt =
-    glareAt 2 10 5 (withAlpha 0.05 white) 20 30
-
-{- Red flash. -}
-bloodFlashAt :: Point2 -> World -> World
-bloodFlashAt p = 
-    over particles (flashFlareAt red 0.4 p : )
-    . glareAt 2 10 5 (withAlpha 0.05 red) 20 30 p
-
 {- Cyan flash. -}
 teslaGunFlashAt :: Point2 -> World -> World
-teslaGunFlashAt p = 
-    over particles (flashFlareAt cyan 0.3 p : )
-    . glareAt 2 10 5 (withAlpha 0.1 cyan) 20 30 p
+teslaGunFlashAt = flareCircleAt cyan 0.7
 
 {- Yellow flash. -}
 laserGunFlashAt :: Point2 -> World -> World
-laserGunFlashAt p =
-    over particles (flashFlareAt yellow 0.2 p : )
-    . glareAt 2 10 5 (withAlpha 0.05 yellow) 20 30 p
+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 ++)
@@ -77,12 +63,14 @@ lowLightPic len wdth col (a,b) w = case thingsHit a b w of
         _   -> blank
   where setCol = color col . setDepth (-0.5) . setLayer 2
 
-flashFlareAt :: Color -> Float -> Point2 -> Particle
-flashFlareAt col alphax (V2 x y) = Particle
-    { _ptDraw = const $ setLayer 2 . setDepth (-0.9) . translate x y 
-                        $ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
-    , _ptUpdate = ptTimer' 1
-    }
+flareCircleAt :: Color -> Float -> Point2 -> World -> World
+flareCircleAt col alphax (V2 x y) = particles %~ (theFlareCircle :)
+  where
+    theFlareCircle = Particle
+        { _ptDraw = const $ setLayer 2 . setDepth 20 . translate x y 
+                            $ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
+        , _ptUpdate = ptTimer' 1
+        }
 
 explosionFlashAt :: Point2 -> World -> World
 explosionFlashAt p =  over tempLightSources ((:) $ tLightTimedIntensity 20 150 intensityFunc p)
@@ -91,27 +79,9 @@ explosionFlashAt p =  over tempLightSources ((:) $ tLightTimedIntensity 20 150 i
         | x < 10 = 1 / (10 - fromIntegral x)
         | otherwise = 1
 
-flameGlareAt :: Point2 -> World -> World
-flameGlareAt = glareAt 1 10 5 (withAlpha 0.05 orange) 8 40
-
 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
 
-
-muzzleFlashAt :: Point2 -> World -> World
-muzzleFlashAt p = over particles (muzzleFlashPt p : )
-                . glareAt 2 10 5 (withAlpha 0.5 white) 20 30 p
-
-muzzleFlashPt :: Point2 -> Particle
-muzzleFlashPt (V2 x y) = Particle
-    { _ptDraw = const $ setDepth 0 
-                    . setLayer 2
-                    . translate x y 
-                    $ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
-    , _ptUpdate = ptTimer' 1
-    }
-
-laserScopeTargetGlow :: Color -> Point2 -> World -> World
-laserScopeTargetGlow col = glareAt 2 3 1 (withAlpha 0.1 col) 15 5
-
+sparkFlashAt :: Point2 -> World -> World
+sparkFlashAt _ = id