Start cleanup
This commit is contained in:
@@ -35,7 +35,7 @@ addTexture texturePath shad = do
|
||||
generateMipmap' Texture2D
|
||||
return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb}
|
||||
|
||||
vaddTextureNoFilter :: String -> VShader -> IO VShader
|
||||
vaddTextureNoFilter :: String -> FullShader -> IO FullShader
|
||||
vaddTextureNoFilter texturePath shad = do
|
||||
Right cmap <- readImage texturePath
|
||||
let tex = convertRGBA8 cmap
|
||||
@@ -48,7 +48,7 @@ vaddTextureNoFilter texturePath shad = do
|
||||
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
|
||||
withArray texData $ \ptr -> do
|
||||
glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
|
||||
return $ shad & vshaderTexture ?~ ShaderTexture {_textureObject = textureOb}
|
||||
return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb}
|
||||
|
||||
addTextureNoFilter :: String -> FullShader -> IO FullShader
|
||||
addTextureNoFilter texturePath shad = do
|
||||
|
||||
+24
-23
@@ -1,6 +1,6 @@
|
||||
module Shader.Compile
|
||||
( makeShader
|
||||
, makeVShader
|
||||
--, makeVShader
|
||||
, makeShaderSized
|
||||
, makeShaderUsingShaderVAO
|
||||
, makeSourcedShader
|
||||
@@ -16,28 +16,28 @@ import Control.Monad
|
||||
--import Control.Lens
|
||||
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
|
||||
|
||||
{- |
|
||||
Compiles a vertex shader found within the shader directory.
|
||||
The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
|
||||
-}
|
||||
makeVShader
|
||||
:: String -- ^ First part of the name of the shader
|
||||
-> [ShaderType] -- ^ Filetype extensions
|
||||
-> [Int] -- ^ The input vertex sizes
|
||||
-> EPrimitiveMode
|
||||
-> IO VShader
|
||||
makeVShader s shaderlist sizes pm = do
|
||||
prog <- makeSourcedShader s shaderlist
|
||||
vaob <- setupVAO sizes
|
||||
return $ VShader
|
||||
{ _vshaderProgram = prog
|
||||
, _vshaderVAO = vaob
|
||||
, _vshaderTexture = Nothing
|
||||
, _vshaderCustomUnis = []
|
||||
, _vshaderDrawPrimitive = pm
|
||||
}
|
||||
--{- |
|
||||
--Compiles a vertex shader found within the shader directory.
|
||||
--The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
|
||||
---}
|
||||
--makeVShader
|
||||
-- :: String -- ^ First part of the name of the shader
|
||||
-- -> [ShaderType] -- ^ Filetype extensions
|
||||
-- -> [Int] -- ^ The input vertex sizes
|
||||
-- -> EPrimitiveMode
|
||||
-- -> IO VShader
|
||||
--makeVShader s shaderlist sizes pm = do
|
||||
-- prog <- makeSourcedShader s shaderlist
|
||||
-- vaob <- setupVAO sizes
|
||||
-- return $ VShader
|
||||
-- { _vshaderProgram = prog
|
||||
-- , _vshaderVAO = vaob
|
||||
-- , _vshaderTexture = Nothing
|
||||
-- , _vshaderCustomUnis = []
|
||||
-- , _vshaderDrawPrimitive = pm
|
||||
-- }
|
||||
|
||||
-- | Takes the VAO and poke strategy from another shader
|
||||
-- | Takes the VAO from another shader
|
||||
makeShaderUsingShaderVAO
|
||||
:: String -- ^ First part of the name of the shader
|
||||
-> [ShaderType] -- ^ Filetype extensions
|
||||
@@ -60,7 +60,8 @@ makeShader
|
||||
:: String -- ^ First part of the name of the shader
|
||||
-> [ShaderType] -- ^ Filetype extensions
|
||||
-> [Int] -- ^ The input vertex sizes
|
||||
-> EPrimitiveMode -> IO FullShader
|
||||
-> EPrimitiveMode
|
||||
-> IO FullShader
|
||||
makeShader s shaderlist sizes pm = do
|
||||
prog <- makeSourcedShader s shaderlist
|
||||
vaob <- setupVAO sizes
|
||||
|
||||
+20
-122
@@ -1,154 +1,55 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE StrictData #-}
|
||||
{- |
|
||||
Datatypes used to setup and pass data to shaders.
|
||||
-}
|
||||
{- | Datatypes used to setup and pass data to shaders. -}
|
||||
module Shader.Data
|
||||
( VAO (..)
|
||||
, VBO (..)
|
||||
, FullShader (..)
|
||||
, VShader (..)
|
||||
, ShaderTexture (..)
|
||||
, EPrimitiveMode (..)
|
||||
, PicShads (..)
|
||||
-- | Lens functions
|
||||
, vao
|
||||
, vaoVBO
|
||||
|
||||
, shaderProgram
|
||||
, shaderVAO
|
||||
, shaderDrawPrimitive
|
||||
, shaderTexture
|
||||
, shaderCustomUnis
|
||||
|
||||
, vshaderProgram
|
||||
, vshaderVAO
|
||||
, vshaderDrawPrimitive
|
||||
, vshaderTexture
|
||||
, vshaderCustomUnis
|
||||
|
||||
, psPoly
|
||||
, psPolyz
|
||||
, psBez
|
||||
, psText
|
||||
, psArc
|
||||
, psEll
|
||||
|
||||
, vbo
|
||||
, vboPtr
|
||||
, vboAttribSizes
|
||||
, vboStride
|
||||
-- | Synonyms
|
||||
, vert
|
||||
, geom
|
||||
, frag
|
||||
|
||||
-- TODO make lenses for VBO object
|
||||
-- , textureObject
|
||||
) where
|
||||
--import Geometry.Data
|
||||
|
||||
import Graphics.Rendering.OpenGL
|
||||
import Foreign
|
||||
import Control.Lens
|
||||
--import Graphics.GL.Types
|
||||
{- | Datatype containing the necessary information for a single shader. -}
|
||||
data FullShader = FullShader
|
||||
{ _shaderProgram :: Program
|
||||
, _shaderVAO :: VAO
|
||||
, _shaderDrawPrimitive :: EPrimitiveMode
|
||||
, _shaderTexture :: Maybe ShaderTexture
|
||||
, _shaderCustomUnis :: [UniformLocation]
|
||||
}
|
||||
{- | Vertex array object: contains the reference to the object,
|
||||
and its buffer targets. -}
|
||||
data VAO = VAO
|
||||
{ _vao :: VertexArrayObject
|
||||
, _vaoVBO :: VBO
|
||||
{ _vao :: VertexArrayObject
|
||||
, _vaoVBO :: VBO
|
||||
}
|
||||
{- | Vertex buffer object: contains the reference to the object,
|
||||
a pointer to a location with space that can be written to the buffer,
|
||||
and a list of attribute pointer sizes.
|
||||
Vertex attributes are interleaved within the vbo. -}
|
||||
data VBO = VBO
|
||||
{ _vbo :: BufferObject
|
||||
, _vboPtr :: Ptr Float
|
||||
{ _vbo :: BufferObject
|
||||
, _vboPtr :: Ptr Float
|
||||
, _vboAttribSizes :: [Int] -- ^ It is not clear to me if this is necessary to store or not
|
||||
, _vboStride :: Int
|
||||
}
|
||||
data VShader = VShader
|
||||
{ _vshaderProgram :: Program
|
||||
, _vshaderVAO :: VAO
|
||||
, _vshaderDrawPrimitive :: EPrimitiveMode
|
||||
, _vshaderTexture :: Maybe ShaderTexture
|
||||
, _vshaderCustomUnis :: [UniformLocation]
|
||||
}
|
||||
data PicShads a = PicShads
|
||||
{ _psPoly :: a
|
||||
, _psPolyz :: a
|
||||
, _psBez :: a
|
||||
, _psText :: a
|
||||
, _psArc :: a
|
||||
, _psEll :: a
|
||||
}
|
||||
-- boilerplate folows
|
||||
instance Functor PicShads where
|
||||
fmap f PicShads
|
||||
{ _psPoly = thePoly
|
||||
, _psPolyz = thePolyz
|
||||
, _psBez = theBez
|
||||
, _psText = theText
|
||||
, _psArc = theArc
|
||||
, _psEll = theEll
|
||||
}
|
||||
= PicShads
|
||||
{ _psPoly = f thePoly
|
||||
, _psPolyz = f thePolyz
|
||||
, _psBez = f theBez
|
||||
, _psText = f theText
|
||||
, _psArc = f theArc
|
||||
, _psEll = f theEll
|
||||
}
|
||||
instance Applicative PicShads where
|
||||
pure a = PicShads a a a a a a
|
||||
(<*>) PicShads
|
||||
{ _psPoly = fPoly
|
||||
, _psPolyz = fPolyz
|
||||
, _psBez = fBez
|
||||
, _psText = fText
|
||||
, _psArc = fArc
|
||||
, _psEll = fEll
|
||||
}
|
||||
PicShads
|
||||
{ _psPoly = thePoly
|
||||
, _psPolyz = thePolyz
|
||||
, _psBez = theBez
|
||||
, _psText = theText
|
||||
, _psArc = theArc
|
||||
, _psEll = theEll
|
||||
}
|
||||
= PicShads
|
||||
{ _psPoly = fPoly thePoly
|
||||
, _psPolyz = fPolyz thePolyz
|
||||
, _psBez = fBez theBez
|
||||
, _psText = fText theText
|
||||
, _psArc = fArc theArc
|
||||
, _psEll = fEll theEll
|
||||
}
|
||||
instance Foldable PicShads where
|
||||
foldr f x PicShads
|
||||
{ _psPoly = thePoly
|
||||
, _psPolyz = thePolyz
|
||||
, _psBez = theBez
|
||||
, _psText = theText
|
||||
, _psArc = theArc
|
||||
, _psEll = theEll
|
||||
}
|
||||
= f thePoly . f thePolyz . f theBez . f theText . f theArc $ f theEll x
|
||||
instance Traversable PicShads where
|
||||
{-# INLINE traverse #-}
|
||||
traverse f PicShads
|
||||
{ _psPoly = x0
|
||||
, _psPolyz = x1
|
||||
, _psBez = x2
|
||||
, _psText = x3
|
||||
, _psArc = x4
|
||||
, _psEll = x5
|
||||
} = PicShads <$> f x0 <*> f x1 <*> f x2 <*> f x3 <*> f x4 <*> f x5
|
||||
{- | Datatype containing the necessary information for a single shader. -}
|
||||
data FullShader = FullShader
|
||||
{ _shaderProgram :: Program
|
||||
, _shaderVAO :: VAO
|
||||
, _shaderDrawPrimitive :: EPrimitiveMode
|
||||
, _shaderTexture :: Maybe ShaderTexture
|
||||
, _shaderCustomUnis :: [UniformLocation]
|
||||
, _vboStride :: Int
|
||||
}
|
||||
{- | Datatype containing the reference to a texture object. -}
|
||||
newtype ShaderTexture = ShaderTexture
|
||||
@@ -166,14 +67,11 @@ data EPrimitiveMode
|
||||
| EQuadStrip
|
||||
| EPolygon
|
||||
| EPatches
|
||||
|
||||
-- | Short synonyms for shader types
|
||||
vert, geom, frag :: ShaderType
|
||||
vert = VertexShader
|
||||
geom = GeometryShader
|
||||
frag = FragmentShader
|
||||
|
||||
makeLenses ''VAO
|
||||
makeLenses ''VBO
|
||||
makeLenses ''FullShader
|
||||
makeLenses ''VShader
|
||||
makeLenses ''PicShads
|
||||
|
||||
+40
-46
@@ -1,22 +1,17 @@
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Shader.Poke
|
||||
( pokeArrayOff
|
||||
( pokeVerxs
|
||||
, pokeLayVerxs
|
||||
, pokeArrayOff
|
||||
, pokePoint3s
|
||||
, pokePoint33s
|
||||
, pokeVerxs
|
||||
, pokeLayVerxs
|
||||
, poke224s
|
||||
, picShadToUMV
|
||||
, picShadToMV
|
||||
, vToPicShad
|
||||
, vToPicShadMV
|
||||
) where
|
||||
import Shader.Data
|
||||
import Shader.Parameters
|
||||
import Picture.Data
|
||||
import Geometry.Data
|
||||
--import Layers
|
||||
|
||||
--import qualified Streaming.Prelude as SP
|
||||
--import Data.Maybe
|
||||
@@ -32,16 +27,16 @@ import qualified Data.Vector.Fusion.Stream.Monadic as VS
|
||||
import Control.Monad.Primitive
|
||||
|
||||
pokeVerxs
|
||||
:: MV.MVector (PrimState IO) VShader
|
||||
:: MV.MVector (PrimState IO) FullShader
|
||||
-> UMV.MVector (PrimState IO) Int
|
||||
-> [Verx]
|
||||
-> IO ()
|
||||
pokeVerxs vbos count vxs = VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs
|
||||
|
||||
pokeVerx :: MV.MVector (PrimState IO) VShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
|
||||
pokeVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
|
||||
pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do
|
||||
typeOff <- UMV.unsafeRead offsets sn
|
||||
basePtr <- fmap (_vboPtr . _vaoVBO . _vshaderVAO) $ MV.read vbos sn
|
||||
basePtr <- _vboPtr . _vaoVBO . _shaderVAO <$> MV.read vbos sn
|
||||
let thePtr = plusPtr basePtr (typeOff * pokeStride sn * floatSize)
|
||||
poke34 thePtr thePos theCol
|
||||
pokeArrayOff thePtr 7 ext
|
||||
@@ -49,37 +44,37 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=the
|
||||
where
|
||||
sn = _unShadNum theShadNum
|
||||
|
||||
vToPicShad :: UMV.MVector (PrimState IO) Int -> IO (PicShads Int)
|
||||
{-# INLINE vToPicShad #-}
|
||||
vToPicShad mv = mapM (UMV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
|
||||
|
||||
vToPicShadMV :: MV.MVector (PrimState IO) Int -> IO (PicShads Int)
|
||||
{-# INLINE vToPicShadMV #-}
|
||||
vToPicShadMV mv = mapM (MV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
|
||||
|
||||
picShadToUMV :: PicShads Int -> IO (UMV.MVector (PrimState IO) Int)
|
||||
{-# INLINE picShadToUMV #-}
|
||||
picShadToUMV (PicShads a b c d e f) = do
|
||||
theVec <- UMV.new 6
|
||||
UMV.write theVec 0 a
|
||||
UMV.write theVec 1 b
|
||||
UMV.write theVec 2 c
|
||||
UMV.write theVec 3 d
|
||||
UMV.write theVec 4 e
|
||||
UMV.write theVec 5 f
|
||||
return theVec
|
||||
|
||||
picShadToMV :: PicShads a -> IO (MV.MVector (PrimState IO) a)
|
||||
{-# INLINE picShadToMV #-}
|
||||
picShadToMV (PicShads a b c d e f) = do
|
||||
theVec <- MV.new 6
|
||||
MV.write theVec 0 a
|
||||
MV.write theVec 1 b
|
||||
MV.write theVec 2 c
|
||||
MV.write theVec 3 d
|
||||
MV.write theVec 4 e
|
||||
MV.write theVec 5 f
|
||||
return theVec
|
||||
--vToPicShad :: UMV.MVector (PrimState IO) Int -> IO (PicShads Int)
|
||||
--{-# INLINE vToPicShad #-}
|
||||
--vToPicShad mv = mapM (UMV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
|
||||
--
|
||||
--vToPicShadMV :: MV.MVector (PrimState IO) Int -> IO (PicShads Int)
|
||||
--{-# INLINE vToPicShadMV #-}
|
||||
--vToPicShadMV mv = mapM (MV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
|
||||
--
|
||||
--picShadToUMV :: PicShads Int -> IO (UMV.MVector (PrimState IO) Int)
|
||||
--{-# INLINE picShadToUMV #-}
|
||||
--picShadToUMV (PicShads a b c d e f) = do
|
||||
-- theVec <- UMV.new 6
|
||||
-- UMV.write theVec 0 a
|
||||
-- UMV.write theVec 1 b
|
||||
-- UMV.write theVec 2 c
|
||||
-- UMV.write theVec 3 d
|
||||
-- UMV.write theVec 4 e
|
||||
-- UMV.write theVec 5 f
|
||||
-- return theVec
|
||||
--
|
||||
--picShadToMV :: PicShads a -> IO (MV.MVector (PrimState IO) a)
|
||||
--{-# INLINE picShadToMV #-}
|
||||
--picShadToMV (PicShads a b c d e f) = do
|
||||
-- theVec <- MV.new 6
|
||||
-- MV.write theVec 0 a
|
||||
-- MV.write theVec 1 b
|
||||
-- MV.write theVec 2 c
|
||||
-- MV.write theVec 3 d
|
||||
-- MV.write theVec 4 e
|
||||
-- MV.write theVec 5 f
|
||||
-- return theVec
|
||||
|
||||
|
||||
poke34 :: Ptr Float -> Point3 -> Point4 -> IO ()
|
||||
@@ -125,17 +120,17 @@ pokePoint3s ptr vals0 = go vals0 0
|
||||
off i = n*3 + i
|
||||
|
||||
pokeLayVerxs
|
||||
:: MV.MVector (PrimState IO) VShader
|
||||
:: MV.MVector (PrimState IO) FullShader
|
||||
-> UMV.MVector (PrimState IO) Int
|
||||
-> [Verx]
|
||||
-> IO ()
|
||||
pokeLayVerxs vbos counts vxs = VS.mapM_ (pokeLayVerx vbos counts) $ VS.fromList vxs
|
||||
|
||||
pokeLayVerx :: MV.MVector (PrimState IO) VShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
|
||||
pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
|
||||
--{-# INLINE pokeLayVerx #-}
|
||||
pokeLayVerx vbos counts vx = do
|
||||
theOff <- UMV.unsafeRead counts vecPos
|
||||
basePtr <- fmap (_vboPtr . _vaoVBO . _vshaderVAO) $ MV.unsafeRead vbos sn
|
||||
basePtr <- _vboPtr . _vaoVBO . _shaderVAO <$> MV.unsafeRead vbos sn
|
||||
let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize)
|
||||
poke34 thePtr thePos theCol
|
||||
pokeArrayOff thePtr 7 (_vxExt vx)
|
||||
@@ -146,7 +141,6 @@ pokeLayVerx vbos counts vx = do
|
||||
theLayer = _vxLayer vx
|
||||
thePos = _vxPos vx
|
||||
theCol = _vxCol vx
|
||||
--basePtr = _vboPtr $ vboFromType vbos sn
|
||||
layOff = theLayer * numSubElements
|
||||
theStride = pokeStride sn
|
||||
|
||||
|
||||
Reference in New Issue
Block a user