To openglraw

src/Data/Preload/Render.hs

@@ -1,15 +1,14 @@
-{-# LANGUAGE StrictData
-  , TemplateHaskell 
-  #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 --{-# OPTIONS_GHC -Wno-unused-top-binds #-}
-module Data.Preload.Render
-    where
-import Shader.Data
+module Data.Preload.Render where
 
-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}
 
@@ -26,8 +25,8 @@ data RenderData = RenderData
     , _textureArrayShader :: FullShader
     , _fullscreenShader :: FullShader
     , _lightingTextureShader :: FullShader
-    --, _fullscreenAlphaHalveShader         :: FullShader
-    , _bloomBlurShader          :: FullShader
+    , --, _fullscreenAlphaHalveShader         :: FullShader
+      _bloomBlurShader :: FullShader
     , _colorBlurShader :: FullShader
     , _barrelShader :: FullShader
     , _grayscaleShader :: FullShader
@@ -47,11 +46,11 @@ data RenderData = RenderData
     , _fboPos :: (FBO, TO)
     , _fboLighting :: (FBO, TO)
     , _fboLightingHigh :: (FBO, TO)
-    , _fboShadow        :: (FBO, (TO,TO))
+    , _fboShadow :: (FBO, (TO, TO))
     , _rboBaseBloom :: GLuint -- RenderbufferObject 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
-    case fboStatus of
-        Complete -> return ()
-        _ -> putStrLn $ "Texture framebuffer status: " ++ show fboStatus
+    checkFBO $ FBO fboName
     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
-    case fboStatus of
-        Complete -> return ()
-        _ -> putStrLn $ "Framebuffer with given stencil status: " ++ show fboStatus
+    checkFBO $ FBO fboName
     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
-    case fboStatus of
-        Complete -> return ()
-        _ -> putStrLn $ "Framebuffer with given stencil and two texture objects status: " ++ show fboStatus
+    checkFBO $ FBO fboName
     return (FBO fboName, (TO to1, TO to2))