Refactor level/room generation modules

src/Picture/Preload.hs

@@ -6,13 +6,8 @@ module Picture.Preload
 import Picture.Data
 
 import Graphics.Rendering.OpenGL hiding (Point (..),translate,scale,imageHeight,imageWidth)
-import qualified Graphics.Rendering.OpenGL as GL
-
-import Codec.Picture
-import qualified Data.Vector.Storable as V
 
 import Control.Lens
---import Control.Monad
 
 import Foreign
 import Shader
@@ -20,12 +15,10 @@ import Shader
 import Geometry (Point2)
 
 data RenderData = RenderData
-    { _textures :: [TextureObject]
-    , _lightSourceShader :: FullShader (Float,Float,Float,Float)
+    { _lightSourceShader :: FullShader (Float,Float,Float,Float)
     , _wallShadowShader  :: FullShader (Point2,Point2,Point2,Point2)
     , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
     , _listShaders :: [FullShader RenderType]
-    , _backVAO :: VAO
     , _dummyVBO :: BufferObject
     , _dummyPtr :: Ptr Float
     }
@@ -87,26 +80,12 @@ preloadRender = do
     bindBuffer ArrayBuffer $= Just dummyvbo
     bufferData ArrayBuffer $= (fromIntegral floatSize, dummyptr, StaticDraw)
 
-    Right cmap' <- readImage "data/texture/smudgedDirt.png"
-    let dirt = convertRGBA8 cmap'
-    dirttex <- genObjectName
-    textureBinding Texture2D $= Just dirttex
-    let texData' = V.toList $ imageData dirt
-        wtex' = fromIntegral $ imageWidth  dirt
-        htex' = fromIntegral $ imageHeight dirt
-    withArray texData' $ \ptr -> do
-        texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D wtex' htex') 0 
-                        (PixelData RGBA UnsignedByte ptr)
-    generateMipmap' Texture2D
-    textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
-
 -- input a list of (attribute location, attrib length) pairs
 -- these will have buffers and pointers created
     backgroundvao <- setupVAO [(0,4),(1,2)]
     
     return $ RenderData
-        { _textures = [dirttex,dirttex]
-        , _listShaders = [bslist,lslist,cslist,aslist,eslist]
+        { _listShaders = [bslist,lslist,cslist,aslist,eslist]
         , _dummyVBO = dummyvbo
         , _dummyPtr = dummyptr
         , _lightSourceShader = lsShad

src/Picture/Render.hs

@@ -1,7 +1,8 @@
 --{-# LANGUAGE Strict #-}
 {-# LANGUAGE DeriveFoldable, StandaloneDeriving #-}
 module Picture.Render
-    ( module Picture.Render
+    ( renderPicture'
+    , renderFoldable
     , picToLTree
     )
     where
@@ -13,45 +14,22 @@ import Control.Monad
 
 import qualified Control.Foldl as F
 
-import Data.Bifunctor
-
+import Picture.Preload
 import Picture.Data
 import Picture.Tree
 import Geometry
 
-import Picture.Preload
-
 import Foreign hiding (rotate)
 
 import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,imageWidth,Polygon,Color,T)
 
 import Data.Foldable
-import Data.List
 import Data.Maybe (fromJust)
 
 import qualified Data.IntMap.Strict as IM
 
 import qualified SDL as SDL
 
-pokeTwoOff :: Ptr Float -> Int -> (Float,Float) -> IO ()
-{-# INLINE pokeTwoOff #-}
-pokeTwoOff ptr n (x,y) = do
-    pokeElemOff ptr (2*n+0) x
-    pokeElemOff ptr (2*n+1) y
-pokeThreeOff :: Ptr Float -> Int -> (Float,Float,Float) -> IO ()
-{-# INLINE pokeThreeOff #-}
-pokeThreeOff ptr n (x,y,z) = do
-    pokeElemOff ptr (3*n+0) x
-    pokeElemOff ptr (3*n+1) y
-    pokeElemOff ptr (3*n+2) z
-pokeFourOff :: Ptr Float -> Int -> (Float,Float,Float,Float) -> IO ()
-{-# INLINE pokeFourOff #-}
-pokeFourOff ptr n (x,y,z,w) = do
-    pokeElemOff ptr (4*n+0) x
-    pokeElemOff ptr (4*n+1) y
-    pokeElemOff ptr (4*n+2) z
-    pokeElemOff ptr (4*n+3) w
-
 renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
                     [(Point2,Point2,Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32)
 renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
@@ -71,7 +49,6 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
         )
 
 -- draw lightmap
-
     nWalls <- F.foldM (pokeShader (_wallShadowShader pdata)) wallPoints
     bindShaderBuffers [_wallShadowShader pdata] [nWalls]
 
@@ -141,8 +118,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
     --return (ticksAfterL, ticks2 + ticks3 + ticks4)
     return (ticksAfterL, wallPokeEnd - wallPokeStart)
 
-bufferOffset :: Integral a => a -> Ptr b
-bufferOffset = plusPtr nullPtr . fromIntegral
+----------------end renderPicture'
 
 renderFoldable :: Foldable f => RenderData -> Float -> Float -> (Float,Float) -> (Float,Float)
                     -> f RenderType -> IO Word32
@@ -163,3 +139,23 @@ renderFoldable pdata rot zoom (tranx,trany) (winx,winy) tree = do
     
     pokeEndTicks <- SDL.ticks
     return $ pokeEndTicks - pokeStartTicks
+
+pokeTwoOff :: Ptr Float -> Int -> (Float,Float) -> IO ()
+{-# INLINE pokeTwoOff #-}
+pokeTwoOff ptr n (x,y) = do
+    pokeElemOff ptr (2*n+0) x
+    pokeElemOff ptr (2*n+1) y
+pokeThreeOff :: Ptr Float -> Int -> (Float,Float,Float) -> IO ()
+{-# INLINE pokeThreeOff #-}
+pokeThreeOff ptr n (x,y,z) = do
+    pokeElemOff ptr (3*n+0) x
+    pokeElemOff ptr (3*n+1) y
+    pokeElemOff ptr (3*n+2) z
+pokeFourOff :: Ptr Float -> Int -> (Float,Float,Float,Float) -> IO ()
+{-# INLINE pokeFourOff #-}
+pokeFourOff ptr n (x,y,z,w) = do
+    pokeElemOff ptr (4*n+0) x
+    pokeElemOff ptr (4*n+1) y
+    pokeElemOff ptr (4*n+2) z
+    pokeElemOff ptr (4*n+3) w
+