Correct projected wall shadows when there is an offset camera

src/Picture/Render.hs

@@ -8,6 +8,7 @@ module Picture.Render
     where
 
 import Shader
+import MatrixHelper
 
 import Control.Lens
 import Control.Monad
@@ -31,8 +32,10 @@ import qualified Data.IntMap.Strict as IM
 import qualified SDL as SDL
 
 renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
-                    [(Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32)
-renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
+                    [(Point2,Point2)] -> [Point4] ->
+                    (Float,Float) -> Picture -> IO (Word32,Word32)
+renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
+                    (viewFromx,viewFromy) pic = do
     wallPokeStart <- SDL.ticks
 
 -- setting the depth function to less, instead of lequal, 
@@ -61,18 +64,25 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
     nWalls <- F.foldM (pokeShader (_wallShadowShader pdata)) wallPoints
     bindShaderBuffers [_wallShadowShader pdata] [nWalls]
 
+    let (tx,ty) = (tranx,trany) -.- (viewFromx,viewFromy)
+
     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
+            $= Vector2 viewFromx viewFromy  -- hopefully this draws as if from the center
+                                     -- it does, but this is not correct when
                                      -- the camera center is not the player position
+    pmat <- (newMatrix RowMajor 
+                $ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy)
+            ) :: IO (GLmatrix GLfloat)
+    uniform ( (fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) !! 1)
+            $= pmat
     drawShader (_wallShadowShader pdata) nWalls
 
     depthMask $= Disabled
     blendFuncSeparate    $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
     stencilTest $= Enabled
     forM_ lightPoints $ \(x,y,r,lum) -> do
-        depthFunc $= Just Less
+--        depthFunc $= Just Less
         clear [StencilBuffer]
         cullFace $= Just Back
 --        stencilOp $= (OpKeep,OpKeep,OpReplace)
@@ -93,11 +103,13 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
         
         let lightPtr = (\(_,ptr,_) -> ptr) $ head 
                             $ _vaoBufferTargets $ _shaderVAO $ _lightSourceShader pdata
-        pokeFourOff lightPtr 0 (x,y,r,lum)
+            (x',y') = zTran $ rotateV (0 - rot) $ (x,y) -.- (tranx,trany)
+            zTran (a,b) = (a*2*zoom / winx, b*2*zoom / winy)
+        pokeFourOff lightPtr 0 (x',y',r,lum)
         bindShaderBuffers [_lightSourceShader pdata] [1]
         
         stencilFunc $= (Equal, 0, 255)
-        depthFunc $= Just Always
+--        depthFunc $= Just Always
         drawShader (_lightSourceShader pdata) 1
         
 --        currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
@@ -228,6 +240,9 @@ renderFoldable pdata rot zoom (tranx,trany) (winx,winy) tree = do
     pokeEndTicks <- SDL.ticks
     return $ pokeEndTicks - pokeStartTicks
 
+------------------------------end renderFoldable
+
+
 pokeTwoOff :: Ptr Float -> Int -> (Float,Float) -> IO ()
 {-# INLINE pokeTwoOff #-}
 pokeTwoOff ptr n (x,y) = do