Refactor flash lighting, improve laser scope lighting

src/Dodge/Base.hs

@@ -171,6 +171,10 @@ canSeeFireVisionAll i j w = (not $ or $ fmap ($ (wallsAlongLine (_crPos icr) (_c
 --    where hitPoint w = myIntersectSegSeg p1 p2 (_wlLine w !! 0) (_wlLine w !! 1)
 --          hitWalls = filter (\w -> Nothing /= hitPoint w) (IM.elems ws)
 
+wallNormal :: Wall -> Point2
+wallNormal wl = normalizeV . vNormal $ a -.- b
+    where (a:b:_) = _wlLine wl
+
 wallsOnLine :: Point2 -> Point2 -> IM.IntMap Wall -> [Wall]
 wallsOnLine p1 p2 ws = hitWalls
     where hitPoint w = intersectSegSeg' p1 p2 (_wlLine w !! 0) (_wlLine w !! 1)

src/Dodge/Item/Weapon.hs

@@ -2144,7 +2144,7 @@ itemLaserScopeEffect
             | invid == _crInvSel cr
                 = w & particles' %~ (:) (makeLaserScope sp ep d reloadFrac)
                     & creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp
-                    & flareWidth 2 1 15 32 col 0.05 0.1 (ep -.- 4 *.* unitVectorAtAngle d) 
+                    & laserScopeTargetGlow col glowPoint 
 -- this flare MAY be buggy... something to do with the creature glare
             | otherwise = w
             where
@@ -2156,6 +2156,9 @@ itemLaserScopeEffect
                 ep = case listToMaybe $ thingsHitLongLine sp xp w of
                         Just (p,_) -> p
                         Nothing -> xp
+                glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of
+                        Just (p,E3x2 wl) -> p +.+ 2 *.* wallNormal wl
+                        _ -> (ep -.- 2 *.* unitVectorAtAngle d)
                 it = (cr ^. crInv) IM.! invid
                 reloadFrac 
                     | _wpLoadedAmmo it == 0 = 1

src/Dodge/Item/Weapon/TriggerType.hs

@@ -3,7 +3,7 @@ module Dodge.Item.Weapon.TriggerType
 import Dodge.Data
 import Dodge.SoundLogic
 import Dodge.CreatureAction (reloadWeapon)
-import Dodge.WorldEvent (muzFlareAt,lowLightAt,tempLightForAt)
+import Dodge.WorldEvent (muzzleFlashAt,tempLightForAt)
 import Dodge.RandomHelp
 
 import Dodge.Item.Weapon.Bullet
@@ -95,7 +95,7 @@ shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> am
 
 withMuzFlare :: (Int -> World -> World) -> Int -> World -> World
 withMuzFlare f cid w = tempLightForAt 3 pos
-                      . muzFlareAt pos2 $ f cid w
+                      . muzzleFlashAt pos2 $ f cid w
     where cr = _creatures w IM.! cid
           dir = _crDir cr
           pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)

src/Dodge/WorldEvent/Flash.hs

@@ -22,14 +22,18 @@ import Control.Lens
 -- glow    : continuous, potentially long, fading, slow changes in alpha
 -- flicker : potentially long, moving, abrupt changes in alpha
 
+glareAt :: Int -> Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> World -> World
+glareAt t len wdth col alphay nrays rad p w = foldr (glareLine t len wdth col alphay p) w ps
+    where ps = map ((+.+) p) $ nRaysRad nrays rad
+
 sparkFlashAt :: Point2 -> World -> World
 sparkFlashAt p =
-    over particles' ((:) (flashFlareAt white 0.2 p))
+--    over particles' ((:) (flashFlareAt white 0.2 p))
-        . glareAt 2 10 5 white 0.05 20 30 p
+        glareAt 2 10 5 white 0.05 20 30 p
 
 bloodFlashAt :: Point2 -> World -> World
 bloodFlashAt p = 
-    over particles' ((:) (flashFlareAt red 0.2 p))
+    over particles' ((:) (flashFlareAt red 0.4 p))
         . glareAt 2 10 5 red 0.05 20 30 p
 
 teslaGunFlashAt :: Point2 -> World -> World
@@ -42,9 +46,6 @@ laserGunFlashAt p =
     over particles' ((:) (flashFlareAt yellow 0.2 p))
         . glareAt 2 10 5 yellow 0.05 20 30 p
 
-glareAt :: Int -> Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> World -> World
-glareAt t len wdth col alphay nrays rad p w = foldr (glareLine t len wdth col alphay p) w ps
-    where ps = map ((+.+) p) $ nRaysRad nrays rad
 
 glareLine :: Int -> Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World
 glareLine t len wdth col alphay a b w = w & particles' %~ (maybeToList linePt ++)
@@ -70,7 +71,7 @@ lowLightPic len wdth col alphay a b w
                     $ thickArc 0 (pi/2) (_crRad cr) wdth
                 where cp = _crPos cr
         _   -> blank
-    where setCol = color (withAlpha alphay col) . setDepth 0 . setLayer 1
+    where setCol = color (withAlpha alphay col) . setDepth (-0.5) . setLayer 2
 
 flashFlareAt :: Color -> Float -> Point2 -> Particle'
 flashFlareAt col alphax (x,y) =
@@ -80,27 +81,6 @@ flashFlareAt col alphax (x,y) =
         , _ptUpdate' = ptTimer' 1
         }
 
-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))
-      . glareAt 2 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))
-      . glareAt 2 10 5 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
-        }
-
 explosionFlashAt :: Point2 -> World -> World
 explosionFlashAt p =  over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p)
                     . glareAt 20 10 5 white 0.3 75 150 p
@@ -115,21 +95,20 @@ lowLightDirected col alpha a b angles w
     = foldr (\angle w' -> glareLine 2 10 5 col alpha a (a +.+ rotateV angle b) w') w angles
 
 
-muzFlareAt :: Point2 -> World -> World
+muzzleFlashAt :: Point2 -> World -> World
-muzFlareAt p = over particles' ((:) (muzzleFlarePt p))
+muzzleFlashAt p = over particles' ((:) (muzzleFlashPt p))
                 . glareAt 2 10 5 white 0.5 20 30 p
 
-muzzleFlarePt :: Point2 -> Particle'
+muzzleFlashPt :: Point2 -> Particle'
-muzzleFlarePt (x,y) =
+muzzleFlashPt (x,y) =
     Particle' 
         { _ptPict' = setDepth 0 
-                        . setLayer 1
+                        . setLayer 2
                         . translate x y 
                         $ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
         , _ptUpdate' = ptTimer' 1
         }
 
-
+laserScopeTargetGlow :: Color -> Point2 -> World -> World
-lowLightAt :: Point2 -> World -> World
+laserScopeTargetGlow col p = glareAt 2 3 1 col 0.1 15 5 p
-lowLightAt p w = glareAt 2 10 5 white 0.5 20 30 p w