To openglraw

src/Data/Preload/Render.hs

@@ -1,57 +1,56 @@
-{-# LANGUAGE StrictData
+{-# LANGUAGE StrictData #-}
-  , TemplateHaskell 
+{-# LANGUAGE TemplateHaskell #-}
-  #-}
+
 --{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-module Data.Preload.Render
+module Data.Preload.Render where
-    where
-import Shader.Data
 
-import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 import Control.Lens
-import qualified Data.Vector.Mutable as MV
 import Control.Monad.Primitive
+import qualified Data.Vector.Mutable as MV
+import Graphics.GL.Core45
+import Shader.Data
 
 newtype FBO = FBO {_unFBO :: GLuint}
 
 newtype TO = TO {_unTO :: GLuint}
 
 data RenderData = RenderData
-    { _lightingWallShadShader   :: FullShader
+    { _lightingWallShadShader :: FullShader
     , _lightingLineShadowShader :: FullShader
-    , _positionalBlankShader    :: FullShader
+    , _positionalBlankShader :: FullShader
-    , _lightingCapShader        :: FullShader
+    , _lightingCapShader :: FullShader
-    , _wallBlankShader          :: FullShader
+    , _wallBlankShader :: FullShader
-    , _windowShader             :: FullShader
+    , _windowShader :: FullShader
-    , _wallTextureShader        :: FullShader
+    , _wallTextureShader :: FullShader
-    , _textureArrayShader       :: FullShader
+    , _textureArrayShader :: FullShader
-    , _fullscreenShader         :: FullShader
+    , _fullscreenShader :: FullShader
-    , _lightingTextureShader    :: FullShader
+    , _lightingTextureShader :: FullShader
-    --, _fullscreenAlphaHalveShader         :: FullShader
+    , --, _fullscreenAlphaHalveShader         :: FullShader
-    , _bloomBlurShader          :: FullShader
+      _bloomBlurShader :: FullShader
-    , _colorBlurShader          :: FullShader
+    , _colorBlurShader :: FullShader
-    , _barrelShader             :: FullShader
+    , _barrelShader :: FullShader
-    , _grayscaleShader          :: FullShader
+    , _grayscaleShader :: FullShader
-    , _shapeShader              :: FullShader
+    , _shapeShader :: FullShader
-    , _shapeEBO         :: EBO
+    , _shapeEBO :: EBO
-    , _silhouetteEBO    :: EBO
+    , _silhouetteEBO :: EBO
-    , _pictureShaders   :: MV.MVector (PrimState IO) FullShader
+    , _pictureShaders :: MV.MVector (PrimState IO) FullShader
-    , _fbo2             :: (FBO, TO)
+    , _fbo2 :: (FBO, TO)
-    , _fbo3             :: (FBO, TO)
+    , _fbo3 :: (FBO, TO)
-    , _fboHalf1         :: (FBO, TO)
+    , _fboHalf1 :: (FBO, TO)
-    , _fboHalf2         :: (FBO, TO)
+    , _fboHalf2 :: (FBO, TO)
-    , _fboHalf3         :: (FBO, TO)
+    , _fboHalf3 :: (FBO, TO)
-    , _fboBase          :: (FBO, (TO, TO))
+    , _fboBase :: (FBO, (TO, TO))
-    , _fboCloud         :: (FBO, (TO, TO))
+    , _fboCloud :: (FBO, (TO, TO))
-    , _fboBloom         :: (FBO, TO)
+    , _fboBloom :: (FBO, TO)
-    , _fboColor         :: (FBO, TO)
+    , _fboColor :: (FBO, TO)
-    , _fboPos           :: (FBO, TO)
+    , _fboPos :: (FBO, TO)
-    , _fboLighting      :: (FBO, TO)
+    , _fboLighting :: (FBO, TO)
-    , _fboLightingHigh  :: (FBO, TO)
+    , _fboLightingHigh :: (FBO, TO)
-    , _fboShadow        :: (FBO, (TO,TO))
+    , _fboShadow :: (FBO, (TO, TO))
-    , _rboBaseBloom     :: GLuint -- RenderbufferObject id
+    , _rboBaseBloom :: GLuint -- RenderbufferObject id
-    , _matUBO           :: GLuint -- BufferObject id
+    , _matUBO :: GLuint -- BufferObject id
     }
+
 makeLenses ''RenderData
 makeLenses ''FBO
 makeLenses ''TO
-

src/Dodge/PreloadData.hs

@@ -1,14 +1,12 @@
 module Dodge.PreloadData where
 
---import qualified Graphics.Rendering.OpenGL as GL
 import Control.Lens
 import Dodge.Data.Universe
 import Preload.Update
---import SDL
 
 sideEffectUpdatePreload :: Int -> Int -> Int -> (Universe -> IO Universe) -> Universe -> IO Universe
 sideEffectUpdatePreload divRes x y f u = do
---    GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral x) (fromIntegral y))
+    --    GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral x) (fromIntegral y))
     pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData u)
     f $ u & preloadData .~ pdata
 

src/Framebuffer/Setup.hs

@@ -6,11 +6,11 @@ module Framebuffer.Setup (
     setupShadowFramebuffer,
 ) where
 
+import Framebuffer.Check
 import Unsafe.Coerce
 import Data.Preload.Render
 import GLHelp
 import Graphics.GL.Core45
-import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
 
 setupTextureFramebuffer ::
     GLsizei ->
@@ -31,10 +31,7 @@ setupTextureFramebuffer x y = do
     --textureFilter Texture2D $= minMagFilter
     --framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
     glNamedFramebufferTexture fboName GL_COLOR_ATTACHMENT0 to 0
-    fboStatus <- framebufferStatus Framebuffer
+    checkFBO $ FBO fboName
-    case fboStatus of
-        Complete -> return ()
-        _ -> putStrLn $ "Texture framebuffer status: " ++ show fboStatus
     return (FBO fboName, TO to)
 
 setupShadowFramebuffer :: IO (FBO, (TO, TO))
@@ -60,10 +57,7 @@ setupFramebufferGivenStencil rboName = do
     to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
     --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
     glNamedFramebufferRenderbuffer fboName GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName
-    fboStatus <- framebufferStatus Framebuffer
+    checkFBO $ FBO fboName
-    case fboStatus of
-        Complete -> return ()
-        _ -> putStrLn $ "Framebuffer with given stencil status: " ++ show fboStatus
     return (FBO fboName, TO to1)
 
 setupFramebuffer2GivenStencil ::
@@ -79,8 +73,5 @@ setupFramebuffer2GivenStencil rboName = do
     to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
     --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
     glNamedFramebufferRenderbuffer fboName GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName
-    fboStatus <- framebufferStatus Framebuffer
+    checkFBO $ FBO fboName
-    case fboStatus of
-        Complete -> return ()
-        _ -> putStrLn $ "Framebuffer with given stencil and two texture objects status: " ++ show fboStatus
     return (FBO fboName, (TO to1, TO to2))