From 021ff857fcf3eab899cdb44c32015d32e80ac3c0 Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 23 Mar 2021 19:36:59 +0100 Subject: [PATCH] Refactor flash lighting, improve laser scope lighting --- src/Dodge/Base.hs | 4 +++ src/Dodge/Item/Weapon.hs | 5 ++- src/Dodge/Item/Weapon/TriggerType.hs | 4 +-- src/Dodge/WorldEvent/Flash.hs | 51 ++++++++-------------------- 4 files changed, 25 insertions(+), 39 deletions(-) diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index e74b5ee91..2aa872c8e 100644 --- a/src/Dodge/Base.hs +++ b/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) diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 5f0568d9e..7f042d776 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 801d04c12..ec9199383 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/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) diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 3f429086d..18e856654 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/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)) - . glareAt 2 10 5 white 0.05 20 30 p +-- over particles' ((:) (flashFlareAt white 0.2 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 -muzFlareAt p = over particles' ((:) (muzzleFlarePt p)) +muzzleFlashAt :: Point2 -> World -> World +muzzleFlashAt p = over particles' ((:) (muzzleFlashPt p)) . glareAt 2 10 5 white 0.5 20 30 p -muzzleFlarePt :: Point2 -> Particle' -muzzleFlarePt (x,y) = +muzzleFlashPt :: Point2 -> Particle' +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 } - -lowLightAt :: Point2 -> World -> World -lowLightAt p w = glareAt 2 10 5 white 0.5 20 30 p w +laserScopeTargetGlow :: Color -> Point2 -> World -> World +laserScopeTargetGlow col p = glareAt 2 3 1 col 0.1 15 5 p