Project wall shadows onto other walls

2021-03-19 12:40:07 +01:00
parent e079289349
commit 5a7be55e24
5 changed files with 102 additions and 71 deletions
@@ -467,43 +467,14 @@ displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $
                    scale 0.2 0.2 $ text $ reverse $ take 5 $ (++ repeat ' ') $ reverse $ show
                    $ _crHP $ _creatures w IM.! n

-wallsForGloom :: World -> [(Point2,Point2,Point2,Point2)]
+wallsForGloom :: World -> [(Point2,Point2)]
 wallsForGloom w = map (linePairs . _wlLine) $ filter (not . _wlIsSeeThrough)
                        $ filter wallCastsShadow
                        $ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
-    where linePairs (x:y:z:w:_) = (x,y,z,w)
-          linePairs (x:y:_) = (x,y,x,y)
+    where linePairs (x:y:_) = (x,y)
          wallCastsShadow wl = case wl ^? wlCastShadow of
                                Just b  -> b
                                Nothing -> True
--(AutoDoor {_wlCastShadow = b}) = b
--          wallCastsShadow _ = True
-
-wallsForGloom' :: World -> [(Point2,Point2)]
-wallsForGloom' w = map (wallPairBack . _wlLine) $ filter (not . _wlIsSeeThrough) 
-                                $ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
-
-   -- where wallPairBack (x:y:_) = (ss $ x +.+ n,ss $ y+.+ n)
-    where wallPairBack (x:y:_) = (x +.+ n,y+.+ n)
-            where n = 15 *.* (normalizeV $ vNormal $ y -.- x)
-      --    ss' v = rotateV (0 - _cameraRot w) (v -.- _cameraPos w)
-      --    ss'' (a,b) = (a*2*zoom / _windowX w,b*2*zoom / _windowY w)
-      --    ss = ss'' . ss'
-- the ss transformation would possibly be better done using a matrix in the
-- shader
-          zoom = _cameraZoom w
--wallsForGloom' :: World -> [(Point2,Point2,Point2,Point2)]
--wallsForGloom' w = map (wallPairToFour . _wlLine) $ filter (not . _wlIsSeeThrough) 
--                                $ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
--
--    where wallPairToFour (x:y:_) = (ss x,ss y,ss $ x +.+ n,ss $ y+.+ n)
--            where n = 15 *.* (normalizeV $ vNormal $ y -.- x)
--          ss' v = rotateV (0 - _cameraRot w) (v -.- _cameraPos w)
--          ss'' (a,b) = (a*2*zoom / _windowX w,b*2*zoom / _windowY w)
--          ss = ss'' . ss'
---- the ss transformation would possibly be better done using a matrix in the
---- shader
--          zoom = _cameraZoom w

 lightsForGloom' :: World -> [(Point4)]
 lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
@@ -516,9 +487,9 @@ lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempL
          sstls = ss . _tlsPos 
          zoom = _cameraZoom w

-lightsForGloom :: World -> [(Point2,Float,Float)]
-lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
-    where getLS ls = (screenShift $ _lsPos ls, _lsRad ls * zoom, _lsIntensity ls)
-          getTLS ls = (screenShift $ _tlsPos ls, _tlsRad ls * zoom, _tlsIntensity ls)
-          screenShift x = zoom *.* rotateV (0 - _cameraRot w) (x -.- _cameraPos w)
-          zoom = _cameraZoom w
+--lightsForGloom :: World -> [(Point2,Float,Float)]
+--lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
+--    where getLS ls = (screenShift $ _lsPos ls, _lsRad ls * zoom, _lsIntensity ls)
+--          getTLS ls = (screenShift $ _tlsPos ls, _tlsRad ls * zoom, _tlsIntensity ls)
+--          screenShift x = zoom *.* rotateV (0 - _cameraRot w) (x -.- _cameraPos w)
+--          zoom = _cameraZoom w
@@ -548,7 +548,7 @@ deadEndRoom = Room
                 ]
    , _rmLinks = lnks
    , _rmPath  = []
-    , _rmPS    = [PS (0,-20) 0 basicLS]
+    , _rmPS    = [PS (0,-10) 0 basicLS]
    , _rmBound = rectNSWE 20 (-20) (-30) 30
    }
    where lnks = [((0,30)  ,0)
@@ -22,7 +22,7 @@ import qualified Control.Foldl as F

 data RenderData = RenderData
    { _lightSourceShader :: FullShader (Float,Float,Float,Float)
-    , _wallShadowShader  :: FullShader (Point2,Point2,Point2,Point2)
+    , _wallShadowShader  :: FullShader (Point2,Point2)
    , _wallLightShader  :: FullShader (Point3)
    , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
    , _fullscreenShader  :: FullShader ()
@@ -171,8 +171,8 @@ vert = VertexShader
 geom = GeometryShader
 frag = FragmentShader

-pokeWPStrat :: (Point2,Point2,Point2,Point2) -> [[[Float]]]
-pokeWPStrat ((x,y),(z,w),(a,b),(c,d)) = [[[x,y,z,w]]]
+pokeWPStrat :: (Point2,Point2) -> [[[Float]]]
+pokeWPStrat ((x,y),(z,w)) = [[[x,y,z,w]]]

 pokeLightWallStrat :: Point3 -> [[[Float]]]
 pokeLightWallStrat (x,y,z) = [[[x,y,z]]]
@@ -31,7 +31,7 @@ import qualified Data.IntMap.Strict as IM
 import qualified SDL as SDL

 renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
-                    [(Point2,Point2,Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32)
+                    [(Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32)
 renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
    wallPokeStart <- SDL.ticks

@@ -53,36 +53,40 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
 -- draw lightmap

    bindFramebuffer Framebuffer $= (_spareFBO pdata)
-    depthFunc $= Just Always
    clearColor $= Color4 0 0.5 0 1
-    clearDepth $= (200)
-    clear [ColorBuffer]
--    depthMask $= Enabled
+    depthFunc $= Just Less
+    clearDepth $= 1
+    clear [ColorBuffer,DepthBuffer]

--    nBoxWalls <- F.foldM (pokeShader (_wallShader pdata)) $ concat $ mkShadFromWall <$> wallPoints <*> lightPoints
    nWalls <- F.foldM (pokeShader (_wallShadowShader pdata)) wallPoints
    bindShaderBuffers [_wallShadowShader pdata] [nWalls]

--    let f (x,y) = (x,y,0)
--        h (x,y) = (x,y,-1)
--        g (a,b,_,_) = [f a,f a,h a,f b,h b,h b]
--        wp = concatMap g wallPoints
--    nLightWalls <- F.foldM (pokeShader (_wallLightShader pdata)) wp
--    bindShaderBuffers [_wallLightShader pdata] [nLightWalls]
+    currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
+    uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
+            $= Vector2 (0::Float) 0  -- hopefully this draws as if from the center
+                                     -- it does, but this is not good for when
+                                     -- the camera center is not the player position
+    drawShader (_wallShadowShader pdata) nWalls

+    depthMask $= Disabled
+    blendFuncSeparate    $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
    stencilTest $= Enabled
    forM_ lightPoints $ \(x,y,r,lum) -> do
-        cullFace $= Just Front
-        clear [DepthBuffer,StencilBuffer]
-
-        stencilOp $= (OpKeep,OpKeep,OpReplace)
-
-        stencilFunc $= (Always, 1, 255)
+        depthFunc $= Just Less
+        clear [StencilBuffer]
+        cullFace $= Just Back
+--        stencilOp $= (OpKeep,OpKeep,OpReplace)
+        stencilOp $= (OpKeep,OpKeep,OpIncr)
+        stencilFunc $= (Always, 0, 255)
 -- currentProgram does get called twice: here and inside drawShader below
        currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
        uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
            $= Vector2 (x) (y)
-        blendFunc $= (Zero,One)
+--        blendFunc $= (Zero,One)
+        drawShader (_wallShadowShader pdata) nWalls
+
+        cullFace $= Just Front
+        stencilOp $= (OpKeep,OpKeep,OpDecr)
        drawShader (_wallShadowShader pdata) nWalls

        cullFace $= Nothing
@@ -92,8 +96,8 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
        pokeFourOff lightPtr 0 (x,y,r,lum)
        bindShaderBuffers [_lightSourceShader pdata] [1]
        
-        blendFuncSeparate    $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
-        stencilFunc $= (Notequal, 1, 255)
+        stencilFunc $= (Equal, 0, 255)
+        depthFunc $= Just Always
        drawShader (_lightSourceShader pdata) 1
        
 --        currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
@@ -103,6 +107,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
 --        depthFunc $= Just Lequal
 --        drawShader (_wallLightShader pdata) nLightWalls

+    depthMask $= Enabled
    cullFace $= Nothing
    stencilTest $= Disabled