From f09fe8798ed3664d4bd09d6fa058680af2e48fa5 Mon Sep 17 00:00:00 2001 From: jgk Date: Sat, 12 Jun 2021 12:21:42 +0200 Subject: [PATCH] Module reorganisation --- app/Main.hs | 3 +- src/{Preload/Data.hs => Data/Preload.hs} | 10 +++---- src/Data/Preload/Render.hs | 28 +++++++++++++++++++ src/Dodge/Config/Update.hs | 2 +- src/Dodge/Data.hs | 2 +- src/Dodge/Render.hs | 2 +- src/Picture/Render.hs | 6 ++-- src/Preload.hs | 5 ++-- src/{Picture/Preload.hs => Preload/Render.hs} | 28 +++---------------- src/Preload/Update.hs | 4 +-- src/Shader.hs | 2 -- src/Shader/Poke.hs | 18 +++++------- 12 files changed, 56 insertions(+), 54 deletions(-) rename src/{Preload/Data.hs => Data/Preload.hs} (87%) create mode 100644 src/Data/Preload/Render.hs rename src/{Picture/Preload.hs => Preload/Render.hs} (89%) diff --git a/app/Main.hs b/app/Main.hs index b836fba4b..819fd4267 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -14,12 +14,13 @@ import Dodge.LoadSound import Dodge.Debug.Flag.Data import Picture import Picture.Render -import Picture.Preload +import Preload.Render import Picture.Tree import Sound import Preload import Sound.Data import Music +import Data.Preload import Control.Lens --import Foreign (Word32) diff --git a/src/Preload/Data.hs b/src/Data/Preload.hs similarity index 87% rename from src/Preload/Data.hs rename to src/Data/Preload.hs index 3df492e65..6aef7b8b1 100644 --- a/src/Preload/Data.hs +++ b/src/Data/Preload.hs @@ -1,13 +1,13 @@ {-# LANGUAGE TemplateHaskell #-} -module Preload.Data +module Data.Preload where -import Control.Lens -import GHC.Word (Word32) - -import Picture.Preload +import Data.Preload.Render import Sound.Data import Music +import Control.Lens +import GHC.Word (Word32) + data PreloadData a = PreloadData { _renderData :: RenderData , _soundData :: SoundData a diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs new file mode 100644 index 000000000..eb8bcfd93 --- /dev/null +++ b/src/Data/Preload/Render.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-unused-top-binds #-} +module Data.Preload.Render + where +import Shader.Data + +import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) +import Control.Lens +data RenderData = RenderData + { _lightingFloorShader :: FullShader + , _lightingOccludeShader :: FullShader + , _lightingWallShader :: FullShader + , _wallBlankShader :: FullShader + , _wallTextureShader :: FullShader + , _backgroundShader :: FullShader + --, _textureShader :: FullShader (Point3,Point2) + , _fullscreenShader :: FullShader + , _boxBlurShader :: FullShader + , _grayscaleShader :: FullShader + , _pictureShaders :: [FullShader] + , _spareFBO :: FramebufferObject + , _fboTexture :: TextureObject + , _fboRenderbufferObject :: RenderbufferObject + , _fbo2 :: (FramebufferObject, TextureObject, RenderbufferObject) + , _fbo3 :: (FramebufferObject, TextureObject, RenderbufferObject) + } +makeLenses ''RenderData + diff --git a/src/Dodge/Config/Update.hs b/src/Dodge/Config/Update.hs index cac6c61c9..939ecdac3 100644 --- a/src/Dodge/Config/Update.hs +++ b/src/Dodge/Config/Update.hs @@ -6,7 +6,7 @@ module Dodge.Config.Update import Dodge.Data.SoundOrigin import Dodge.Config.Data import Sound -import Preload.Data +import Data.Preload import Preload.Update import Data.Aeson (encodeFile) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 62ef4078f..28225fe3c 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -27,7 +27,7 @@ import Dodge.Config.KeyConfig import Dodge.Item.Attachment.Data import Dodge.Item.Data import Dodge.World.Trigger.Data -import Preload.Data +import Data.Preload import Picture.Data import Geometry.Data import Sound.Data diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 05daa6494..fca1a9408 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -15,7 +15,7 @@ import Dodge.Render.Picture import Geometry --import Picture import Picture.Render -import Picture.Preload +import Data.Preload.Render import Picture.Data import Picture.Tree import Shader diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index fd43462c7..7d6153b73 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -9,7 +9,7 @@ import Shader import Shader.Data import Shader.Poke --import MatrixHelper -import Picture.Preload +import Data.Preload.Render import Picture.Data import Geometry @@ -260,8 +260,8 @@ renderFoldable pdata struct = do let slist = _pictureShaders pdata --- poke data, returns list of number of vertices for each shader - is <- F.foldM (pokeShaders slist) struct +-- poke data, returns list buffer sizes for each shader + is <- F.foldM (traverse pokeShader slist) struct -- the idea of binding many buffers at once, rather than interweaving with draw -- calls, is to prevent opengl from waiting for a draw call to finish diff --git a/src/Preload.hs b/src/Preload.hs index 5416a69ca..951c7eb8f 100644 --- a/src/Preload.hs +++ b/src/Preload.hs @@ -1,12 +1,11 @@ module Preload ( module Preload - , module Preload.Data , module Preload.Update ) where -import Preload.Data +import Data.Preload import Preload.Update -import Picture.Preload +import Preload.Render import Sound.Data --import Control.Lens diff --git a/src/Picture/Preload.hs b/src/Preload/Render.hs similarity index 89% rename from src/Picture/Preload.hs rename to src/Preload/Render.hs index a63a5e8bb..b40206797 100644 --- a/src/Picture/Preload.hs +++ b/src/Preload/Render.hs @@ -1,8 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} -module Picture.Preload - ( RenderData (..) - , preloadRender +module Preload.Render + ( preloadRender , cleanUpRenderPreload ) where @@ -12,31 +11,12 @@ import Shader.Data import Shader.Compile import Shader.AuxAddition import Geometry.Data +import Data.Preload.Render import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) -import Control.Lens +--import Control.Lens import Foreign -data RenderData = RenderData - { _lightingFloorShader :: FullShader - , _lightingOccludeShader :: FullShader - , _lightingWallShader :: FullShader - , _wallBlankShader :: FullShader - , _wallTextureShader :: FullShader - , _backgroundShader :: FullShader - --, _textureShader :: FullShader (Point3,Point2) - , _fullscreenShader :: FullShader - , _boxBlurShader :: FullShader - , _grayscaleShader :: FullShader - , _pictureShaders :: [FullShader] - , _spareFBO :: FramebufferObject - , _fboTexture :: TextureObject - , _fboRenderbufferObject :: RenderbufferObject - , _fbo2 :: (FramebufferObject, TextureObject, RenderbufferObject) - , _fbo3 :: (FramebufferObject, TextureObject, RenderbufferObject) - } -makeLenses ''RenderData - preloadRender :: IO RenderData preloadRender = do -- lighting shaders diff --git a/src/Preload/Update.hs b/src/Preload/Update.hs index f8b787824..e2ff1a4ab 100644 --- a/src/Preload/Update.hs +++ b/src/Preload/Update.hs @@ -2,10 +2,10 @@ module Preload.Update ( resizeSpareFBO ) where -import Preload.Data +import Data.Preload +import Data.Preload.Render import Graphics.Rendering.OpenGL import Foreign -import Picture.Preload resizeSpareFBO :: Int -- ^ Lightmap width diff --git a/src/Shader.hs b/src/Shader.hs index 9e8312a67..fe6748a80 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -50,8 +50,6 @@ drawShader fs i = do _ -> return () drawArrays (_shaderDrawPrimitive fs) 0 (fromIntegral i) - - resetShaderUniforms :: [(Program, UniformLocation)] -> IO () {-# INLINE resetShaderUniforms #-} resetShaderUniforms = setShaderUniforms 0 1 (0,0) (2,2) diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index c91c0d76a..19c3b4f6a 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -1,6 +1,5 @@ module Shader.Poke - ( pokeShaders - , pokeArrayOff + ( pokeArrayOff , pokeShader ) where import Shader.Data @@ -10,28 +9,25 @@ import Foreign import Control.Monad import qualified Control.Foldl as F -pokeShaders :: [FullShader] -> F.FoldM IO RenderType [Int] -pokeShaders = traverse pokeShader - pokeShader :: FullShader -> F.FoldM IO RenderType Int -pokeShader fs = F.FoldM (pokeRender fls ptr stride) (return 0) return +pokeShader fs = F.FoldM (pokeVertices fls ptr stride) (return 0) return where theVBO = _vaoVBO $ _shaderVAO fs ptr = _vboPointer theVBO stride = sum $ _vboAttribSizes theVBO fls = _shaderPokeStrategy fs -pokeRender +pokeVertices :: (RenderType -> [[Float]]) -> Ptr Float -> Int -- ^ stride - -> Int + -> Int -- ^ number of vertices already poked -> RenderType -> IO Int -pokeRender toFs ptr stride n rt = foldM (pokePtrs ptr stride) n (toFs rt) +pokeVertices toFs ptr stride n rt = foldM (pokeVertex ptr stride) n (toFs rt) -pokePtrs :: Ptr Float -> Int -> Int -> [Float] -> IO Int -pokePtrs ptr stride n fs = do +pokeVertex :: Ptr Float -> Int -> Int -> [Float] -> IO Int +pokeVertex ptr stride n fs = do pokeArrayOff ptr (stride * n) fs return $ n + 1