justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Make light position uniform 3d

Browse Source
This commit is contained in:
jgk
2021-06-25 01:19:20 +02:00
parent b451953b99
commit b6feccd934
10 changed files with 40 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Inanimate.hs
+2 -1
View File
@@ -55,9 +55,10 @@ updateLamp i = unrandUpdate handleLS internalUpdate
handleLS cr w
| _crHP cr < 0 = explosionFlashAt cPos
$ mkSoundBreakGlass cPos w & lightSources %~ IM.delete i
| otherwise = w & lightSources . ix i . lsPos .~ cPos
| otherwise = w & lightSources . ix i . lsPos .~ f cPos
where
cPos = _crPos cr
f (x,y) = (x,y,0)
internalUpdate cr
| _crHP cr < 0 = Nothing
| otherwise = Just $ doDamage cr
src/Dodge/Data.hs
+2 -2
View File
@@ -130,13 +130,13 @@ data Cloud = Cloud
}
data LightSource = LS
{ _lsID :: !Int
, _lsPos :: !Point2
, _lsPos :: !Point3
, _lsDir :: !Float
, _lsRad :: !Float
, _lsIntensity :: !Float
}
data TempLightSource = TLS
{ _tlsPos :: !Point2
{ _tlsPos :: !Point3
, _tlsRad :: !Float
, _tlsIntensity :: !Float
, _tlsUpdate :: World -> TempLightSource -> (World, Maybe TempLightSource)
src/Dodge/Default/World.hs
+4 -2
View File
@@ -86,8 +86,10 @@ defaultDebugFlags = DebugFlags
}
youLight :: TempLightSource
youLight =
TLS { _tlsPos = (0,0)
TLS { _tlsPos = (0,0,0)
,_tlsRad = 300
,_tlsIntensity = 0.1
,_tlsUpdate = \w _ -> (w, Just (youLight {_tlsPos = _crPos (you w)}))
,_tlsUpdate = \w _ -> (w, Just (youLight {_tlsPos = f $ _crPos (you w)}))
}
where
f (x,y) = (x,y,0)
src/Dodge/LevelGen.hs
+2 -2
View File
@@ -189,11 +189,11 @@ placeCr crF p rot = over creatures addCr
crs
placeLS :: LightSource -> Picture -> Point2 -> Float -> World -> World
placeLS ls dec p rot w = over lightSources addLS $ over decorations addDec w
placeLS ls dec p@(x,y) rot w = over lightSources addLS $ over decorations addDec w
where
addLS lss = IM.insert
(IM.newKey lss)
(ls {_lsPos = p,_lsDir = rot,_lsID = IM.newKey lss})
(ls {_lsPos = (x,y,0),_lsDir = rot,_lsID = IM.newKey lss})
lss
addDec decs = IM.insert
(IM.newKey decs)
src/Dodge/LightSources.hs
+10 -10
View File
@@ -9,9 +9,9 @@ import Picture
--import qualified Data.IntMap.Strict as IM
lightAt :: Point2 -> Int -> LightSource
lightAt p i =
lightAt (x,y) i =
LS {_lsID = i
,_lsPos = p
,_lsPos = (x,y,0)
,_lsDir = 0
,_lsRad = 600
,_lsIntensity = 0.75
@@ -23,14 +23,14 @@ basicLS = PutLS ls dec
dec = onLayer PtLayer $ color white $ circleSolid 8
tLightFade :: Int -> Float -> (Int -> Float) -> Point2 -> TempLightSource
tLightFade 0 rmax intensityF p = TLS
{ _tlsPos = p
tLightFade 0 rmax intensityF (x,y) = TLS
{ _tlsPos = (x,y,0)
, _tlsRad = rmax
, _tlsIntensity = intensityF 0
, _tlsUpdate = \w _ -> (w, Nothing)
}
tLightFade i rmax intensityF p = TLS
{ _tlsPos = p
tLightFade i rmax intensityF p@(x,y) = TLS
{ _tlsPos = (x,y,0)
, _tlsRad = rmax
, _tlsIntensity = intensityF i
, _tlsUpdate = \w _ -> (w, Just $ tLightFade (i-1) rmax intensityF p)
@@ -42,14 +42,14 @@ tLightRad
-> Float -- ^ minimal radius (unused)
-> Point2
-> TempLightSource
tLightRad 0 rmax _ p = TLS
{ _tlsPos = p
tLightRad 0 rmax _ (x,y) = TLS
{ _tlsPos = (x,y,0)
, _tlsRad = rmax
, _tlsIntensity = 0.5
, _tlsUpdate = \w _ -> (w, Nothing)
}
tLightRad i rmax rmin p = TLS
{ _tlsPos = p
tLightRad i rmax rmin p@(x,y) = TLS
{ _tlsPos = (x,y,0)
, _tlsRad = rmax
, _tlsIntensity = 0.5
, _tlsUpdate = \w _ -> (w, Just $ tLightRad (i-1) rmax rmin p)
src/Dodge/Render/Picture.hs
+3 -3
View File
@@ -217,8 +217,8 @@ wallsForShadows w = map _wlLine
. filter (not . _wlIsSeeThrough)
. IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
lightsForGloom :: World -> [Point4]
lightsForGloom :: World -> [(Point3,Float,Float)]
lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
where
getLS ls = ( fst $ _lsPos ls, snd $ _lsPos ls, _lsRad ls , _lsIntensity ls)
getTLS ls = ( fst $ _tlsPos ls,snd $ _tlsPos ls, _tlsRad ls, _tlsIntensity ls)
getLS ls = ( _lsPos ls, _lsRad ls , _lsIntensity ls)
getTLS ls = ( _tlsPos ls, _tlsRad ls, _tlsIntensity ls)
src/Dodge/WorldEvent/Flash.hs
+5 -4
View File
@@ -86,10 +86,11 @@ flashFlareAt col alphax (x,y) = Particle
explosionFlashAt :: Point2 -> World -> World
explosionFlashAt p = over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p)
. glareAt 20 10 5 (withAlpha 0.3 white) 75 150 p
where intensityFunc x
| x < 10 = 1 / (10 - fromIntegral x)
| otherwise = 1
. glareAt 20 10 5 (withAlpha 0.3 white) 75 150 p
where
intensityFunc x
| x < 10 = 1 / (10 - fromIntegral x)
| otherwise = 1
flameGlareAt :: Point2 -> World -> World
flameGlareAt = glareAt 1 10 5 (withAlpha 0.05 orange) 8 40
src/Picture/Render.hs
+4 -5
View File
@@ -55,12 +55,11 @@ createLightMap
:: RenderData
-> Int -- Resolution division
-> [(Point2,Point2)] -- Wall pairs
-> [Point4] -- Lights
-> [(Point3,Float,Float)] -- Lights
-> (Float,Float) -- View from position
-> Picture -- foreground pictures
-> IO ()
createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) _ = do
-- get viewport size so we can reset it later
(vppos,vpsize) <- get viewport
-- set the viewport size to that of the render buffer
@@ -97,7 +96,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) _ = do
depthMask $= Disabled
blendFunc $= (Zero, OneMinusSrcAlpha)
stencilTest $= Enabled
forM_ lightPoints $ \(x,y,r,lum) -> do
forM_ lightPoints $ \((x,y,z),r,lum) -> do
-- bind buffer for floor light circle
let lightPtr = _vboPointer $ _vaoVBO $ _shaderVAO $ _lightingFloorShader pdata
pokeFourOff lightPtr 0 (x,y,r,lum)
@@ -109,7 +108,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) _ = do
stencilFunc $= (Always, 0, 255)
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata)
$= Vector2 x y
$= Vector3 x y z
drawShader (_lightingOccludeShader pdata) nWalls
cullFace $= Just Front
stencilOp $= (OpKeep,OpKeep,OpDecr)
@@ -123,7 +122,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) _ = do
-- draw wall light "circles"
currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
uniform (head $ _shaderCustomUnis $ _lightingWallShader pdata)
$= Vector2 x y
$= Vector3 x y z
uniform (_shaderCustomUnis (_lightingWallShader pdata) !! 1)
$= Vector2 r lum
drawShader (_lightingWallShader pdata) nWallLights