Implement foreground correctly, not with shadows though

src/Dodge/Data.hs

@@ -74,7 +74,6 @@ data World = World
     , _sounds               :: M.Map SoundOrigin Sound
     , _decorations          :: IM.IntMap Picture
     , _foregroundDecorations :: [Picture]
-    , _midgroundDecorations :: [Picture]
     , _corpses              :: IM.IntMap (IM.IntMap [Corpse])
     , _clickMousePos        :: (Float,Float)
     , _pathGraph            :: ~(Gr Point2 Float)

src/Dodge/Default.hs

@@ -89,14 +89,12 @@ defaultWorld = World
     , _inventoryMode = TopInventory
     , _lClickHammer = HammerUp
     , _foregroundDecorations = 
-        [setDepth (-0.2) $ rotate 0.75 $ pictures
-            $ map f [5,25,45,65]
-        ]
-    , _midgroundDecorations = 
         [ setDepth (-0.1) $ color orange $ pictures
             [ polygon $ rectNSEW 50 40 140 (-20)
             , translate 60 45 $ scale 0.5 1 $  thickArc 0 pi 75 10
             ]
+        , setDepth (-0.2) $ rotate 0.75 $ pictures
+            $ map f [5,25,45,65]
         ]
     }
   where 

src/Dodge/Render.hs

@@ -11,17 +11,19 @@ import Dodge.Base
 --import Dodge.Render.HUD
 --import Dodge.Render.MenuScreen
 import Dodge.Render.Picture
-import Dodge.Render.PerspectiveMatrix
+--import Dodge.Render.PerspectiveMatrix
 import Geometry
 --import Picture
 import Picture.Render
 import Picture.Preload
 import Shader
+import MatrixHelper
 
 import Foreign (Word32)
 --import Control.Applicative
 --import Control.Monad.State
 import Control.Lens
+import Control.Monad
 import qualified Control.Foldl as F
 import Data.Tuple.Extra
 import Data.Maybe
@@ -89,20 +91,10 @@ doDrawing pdata w = do
     -- the ordering between these and transparent clouds perhaps presents a challenge
     renderBlankWalls pdata windowPoints pmat
 
-    setShaderUniforms rot (camzoom * (1/ 0.9)) trans wins
-        $ map extractProgAndUnis $ _pictureShaders pdata
-    depthFunc $= Just Lequal
-    _ <- renderFoldable pdata $ picToLTree (Just 0) (midgroundPics w)
-
-    --depthMask $= Enabled
-    -- set the coordinate uniforms for the foreground
-    setShaderUniforms rot (camzoom * (1/ 0.8)) trans wins
-        $ map extractProgAndUnis $ _pictureShaders pdata
-    blendFunc $= (One,Zero)
-    depthFunc $= Just Always
-    _ <- renderFoldable pdata $ picToLTree (Just 0) (foregroundPics w)
-
     depthMask $= Enabled
+    forM_ (_pictureShaders pdata) $ setPerpMatUniform rot camzoom trans wins viewFroms
+    depthFunc $= Just Lequal
+    _ <- renderFoldable pdata $ picToLTree (Just 0) (foregroundPics w)
 
     -- draw the fbo to the screen
     -- allows for post-processing

src/Dodge/Render/PerspectiveMatrix.hs

@@ -1,49 +0,0 @@
-module Dodge.Render.PerspectiveMatrix
-    where
-import Geometry
-
-import Linear.Matrix
-import Linear.V4
-import Graphics.Rendering.OpenGL (GLfloat)
-
-perspectiveMatrix 
-    :: Float        -- ^ Rotation
-    -> Float        -- ^ Zoom
-    -> Point2       -- ^ Translation
-    -> Point2       -- ^ Window size
-    -> Point2       -- ^ View froms
-    -> [GLfloat]
-perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
-    let scalMat = Linear.Matrix.transpose $ V4 
-            (V4 (2*zoom/winx) 0             0   (0::GLfloat))
-            (V4 0             (2*zoom/winy) 0   0)
-            (V4 0             0             0.5 0) --scaled to make walls shorter
-            (V4 0             0             0   1)
-        rotMat = Linear.Matrix.transpose $
-            V4 (V4 (cos rot) (sin (-rot)) 0 0)
-                (V4 (sin rot) (cos rot)    0 0)
-                (V4 0             0        1 0)
-                (V4 0             0        0 1)
-        --tranMat3 = Linear.Matrix.transpose $
-        --    V4 (V4 1        0        0 0)
-        --        (V4 0        1        0 0)
-        --        (V4 0        0        1 0)
-        --        (V4 (-tranx) (-trany) 0 1)
-        tranMat2 = Linear.Matrix.transpose $
-            V4 (V4 1        0        0 0)
-                (V4 0        1        0 0)
-                (V4 0        0        1 0)
-                (V4 (viewFromx-tranx) (viewFromy-trany) 0 1)
-        perMat = Linear.Matrix.transpose $
-             V4 (V4 1 0 0 0)
-                (V4 0 1 0 0)
-                (V4 0 0 1 1)
-                (V4 0 0 0 1)
-        tranMat1 = Linear.Matrix.transpose $
-             V4 (V4 1        0        0 0)
-                (V4 0        1        0 0)
-                (V4 0        0        1 0)
-                (V4 (-viewFromx) (-viewFromy) 0 1)
-        wmat = scalMat !*! rotMat !*! tranMat2 !*! perMat !*! tranMat1
-        vToL (V4 a b c d) = [a,b,c,d]
-    in concatMap vToL $ vToL wmat

src/Dodge/Render/Picture.hs

@@ -28,9 +28,6 @@ worldPictures w = pictures $ concat
     , map drawWallFloor (wallFloorsToDraw w)
     , testPic w
     ]
-midgroundPics :: World -> Picture
-midgroundPics = pictures . _midgroundDecorations
-
 foregroundPics :: World -> Picture
 foregroundPics = pictures . _foregroundDecorations
 

src/MatrixHelper.hs

@@ -1,12 +1,19 @@
 module MatrixHelper
-    where
+    ( perspectiveMatrix
+    ) where
 import Geometry
 
 import Linear.Matrix
 import Linear.V4
 import Graphics.Rendering.OpenGL (GLfloat)
 
-perspectiveMatrix :: Float -> Float -> Point2 -> Point2 -> Point2 -> [GLfloat]
+perspectiveMatrix 
+    :: Float        -- ^ Rotation
+    -> Float        -- ^ Zoom
+    -> Point2       -- ^ Translation
+    -> Point2       -- ^ Window size
+    -> Point2       -- ^ View froms
+    -> [GLfloat]
 perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
     let scalMat = Linear.Matrix.transpose $ V4 
             (V4 (2*zoom/winx) 0             0   (0::GLfloat))

src/Shader.hs

@@ -16,11 +16,13 @@ module Shader
     , resetShaderUniforms
     , extractProgAndUnis 
     , freeShaderPointers
+    , setPerpMatUniform
     , module Shader.Data
     )
   where
 import Geometry
 import Shader.Data
+import MatrixHelper
 
 import Foreign
 import Codec.Picture
@@ -250,6 +252,20 @@ setShaderUniforms rot czoom (tranx,trany) (winx,winy) fss = do
         uniform (snd shad !! 3) $= Vector2 tranx trany
         uniform (snd shad !! 4) $= wmata
 
+setPerpMatUniform 
+    :: Float -- ^ rotation
+    -> Float -- ^ zoom
+    -> Point2 -- ^ translation
+    -> Point2 -- ^ window size
+    -> Point2 -- ^ viewfrom point
+    -> FullShader a
+    -> IO ()
+setPerpMatUniform rot czoom trans wins vFrom shad = do
+    pmat <- (newMatrix RowMajor $ perspectiveMatrix rot czoom trans wins vFrom) :: IO (GLmatrix GLfloat)
+    currentProgram $= Just (_shaderProgram shad)
+    uniform (_shaderUniforms shad !! 4) $= pmat
+    return ()
+
 freeShaderPointers :: FullShader a -> IO ()
 freeShaderPointers fs = do
     forM_ (_vaoBufferTargets $ _shaderVAO fs) $ \(_,ptr,_) ->