Add test tileset textures

src/Picture/Preload.hs

@@ -22,6 +22,7 @@ data RenderData = RenderData
     , _wallBlankShader          :: FullShader ((Point2,Point2),Point4)
     , _wallTextureShader        :: FullShader ((Point2,Point2),Point4)
     , _backgroundShader         :: FullShader (Point2,Point2,Point2,Point2)
+    , _textureShader            :: FullShader (Point3,Point2)
     , _fullscreenShader         :: FullShader ()
     , _boxBlurShader            :: FullShader ()
     , _grayscaleShader          :: FullShader ()
@@ -85,6 +86,11 @@ preloadRender = do
 -- textured wallShader
     wlTexture <- makeShader "wall/texture" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat
                 >>= addTexture "data/texture/grayscaleDirt.png"
+
+-- texture shader
+    textShad <- makeShader "texture/simpleWorld" [vert,frag] [(0,3),(1,2)] Triangles poke32
+        >>= addTexture "data/texture/ayene_wooden_floor.png"
+
 -- framebuffer for lighting
     (fbo,fboTO,fboRBO) <- setupFramebufferWithStencil
     framebuf2 <- setupFramebufferWithStencil
@@ -98,6 +104,7 @@ preloadRender = do
         , _lightingWallShader       = wlLightShad
         , _wallBlankShader          = wlBlank
         , _wallTextureShader        = wlTexture
+        , _textureShader            = textShad
         , _backgroundShader         = bgShad
         , _fullscreenShader         = fsShad
         , _boxBlurShader            = boxBlurShad
@@ -209,5 +216,8 @@ pokeWPStrat ((x,y),(z,w)) = [[[x,y,z,w]]]
 pokeWPColStrat :: ((Point2,Point2),Point4) -> [[[Float]]]
 pokeWPColStrat (((x,y),(z,w)),(r,g,b,a)) = [[[x,y,z,w],[r,g,b,a]]]
 
+poke32 :: (Point3,Point2) -> [[[Float]]]
+poke32 ((x,y,z),(a,b)) = [[[x,y,z],[a,b]]]
+
 pokeBGStrat :: a -> [[[Float]]]
 pokeBGStrat = const []

src/Picture/Render.hs

@@ -31,7 +31,7 @@ setWallDepth
     -> (Float,Float)        -- ^ View from point
     -> GLmatrix GLfloat
     -> IO Word32
-setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do
+setWallDepth pdata wallPoints (viewFromx,viewFromy) _ = do
     startTicks <- SDL.ticks
     colorMask $= Color4 Disabled Disabled Disabled Disabled
     nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) wallPoints
@@ -41,6 +41,8 @@ setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do
     -- reseting this uniform appears to be necessary
     uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
             $= Vector2 viewFromx viewFromy  
+    -- the following uniform, however, was probably already set by
+    -- createLightMap
 --    uniform ( (_shaderMatrixUniform $ _lightingOccludeShader pdata))
 --            $= pmat
 --    cullFace $= Just Front
@@ -92,8 +94,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
     currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
     uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
             $= Vector2 viewFromx viewFromy  
-    uniform ( (_shaderMatrixUniform $ _lightingOccludeShader pdata))
-            $= pmat
+    uniform (_shaderMatrixUniform $ _lightingOccludeShader pdata) $= pmat
     cullFace $= Just Back
     drawShader (_lightingOccludeShader pdata) nWalls
 
@@ -225,6 +226,34 @@ setCommonUniforms pdata rot camZoom (tranx,trany) (winx,winy) = do
         : map extractProgAndUnis (_pictureShaders pdata)
         )
 
+setIsoMatrixUniforms 
+    :: RenderData
+    -> Float            -- ^ Rotation
+    -> Float            -- ^ Zoom
+    -> (Float,Float)    -- ^ Translation
+    -> (Float,Float)    -- ^ Window size
+    -> IO ()
+setIsoMatrixUniforms pdata rot camZoom (tranx,trany) (winx,winy) = do
+    setShaderUniforms rot camZoom (tranx,trany) (winx,winy) 
+        ( extractProgAndUnis (_lightingFloorShader pdata) 
+        : extractProgAndUnis (_backgroundShader pdata) 
+        : extractProgAndUnis (_textureShader pdata)
+        : map extractProgAndUnis (_pictureShaders pdata)
+        )
+
+renderShader
+    :: Foldable f
+    => FullShader a
+    -> f a
+    -> IO Word32
+renderShader shad dat = do
+    sticks <- SDL.ticks
+    i <- F.foldM  (pokeShader shad) dat
+    bindShaderBuffers [shad] [i]
+    drawShader shad i
+    eticks <- SDL.ticks
+    return $ eticks - sticks
+
 renderFoldable
     :: Foldable f
     => RenderData