Refactor flash lighting, improve laser scope lighting

This commit is contained in:
jgk
2021-03-23 19:36:59 +01:00
parent 3e2eaeece2
commit 021ff857fc
4 changed files with 25 additions and 39 deletions
+4
View File
@@ -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)
+4 -1
View File
@@ -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
+2 -2
View File
@@ -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)
+15 -36
View File
@@ -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