Continue refactoring shaders
This commit is contained in:
+11
-85
@@ -5,10 +5,10 @@ module Picture.Preload
|
||||
|
||||
import Picture.Data
|
||||
|
||||
import Codec.Picture
|
||||
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
|
||||
@@ -16,15 +16,15 @@ import Control.Monad
|
||||
|
||||
import Foreign
|
||||
|
||||
import Shaders
|
||||
import Shader
|
||||
|
||||
data RenderData = RenderData
|
||||
{ --_charMap :: Image PixelRGBA8
|
||||
_textures :: [TextureObject]
|
||||
, _lightmapCircleShader :: (Program, [UniformLocation])
|
||||
, _backShader :: (Program, [UniformLocation])
|
||||
, _wallShadowShader :: (Program, [UniformLocation])
|
||||
, _listShaders :: [FullShader]
|
||||
, _lightmapCircleShader :: (Program, [UniformLocation])
|
||||
, _listShaders :: [FullShader RenderType]
|
||||
, _backVAO :: VAO
|
||||
, _wallVAO :: VAO
|
||||
, _fadeCircVAO :: VAO
|
||||
@@ -35,46 +35,6 @@ data RenderData = RenderData
|
||||
|
||||
makeLenses ''RenderData
|
||||
|
||||
makeShader :: String -> [ShaderType] -> [(GLuint,Int)] -> PrimitiveMode -> (RenderType -> [[[Float]]]) -> IO FullShader
|
||||
makeShader s shaderlist alocs pm renStrat = do
|
||||
(prog,unis) <- makeSourcedShader s shaderlist
|
||||
vao <- setupVAO alocs
|
||||
return $ FullShader { _shaderProgram = prog
|
||||
, _shaderUniforms = unis
|
||||
, _shaderVAO = vao
|
||||
, _shaderPokeStrategy = renStrat
|
||||
, _shaderDrawPrimitive = pm
|
||||
, _shaderTexture = Nothing
|
||||
}
|
||||
makeTextureShader :: String -> [ShaderType] -> [(GLuint,Int)]
|
||||
-> PrimitiveMode -> (RenderType -> [[[Float]]])
|
||||
-> String
|
||||
-> IO FullShader
|
||||
makeTextureShader s shaderlist alocs pm renStrat texturePath = do
|
||||
(prog,unis) <- makeSourcedShader s shaderlist
|
||||
|
||||
Right cmap <- readImage texturePath
|
||||
let tex = convertRGBA8 cmap
|
||||
textureOb <- genObjectName
|
||||
textureBinding Texture2D $= Just textureOb
|
||||
let texData = V.toList $ imageData tex
|
||||
wtex = fromIntegral $ imageWidth tex
|
||||
htex = fromIntegral $ imageHeight tex
|
||||
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)
|
||||
|
||||
vao <- setupVAO alocs
|
||||
|
||||
return $ FullShader { _shaderProgram = prog
|
||||
, _shaderUniforms = unis
|
||||
, _shaderVAO = vao
|
||||
, _shaderPokeStrategy = renStrat
|
||||
, _shaderDrawPrimitive = pm
|
||||
, _shaderTexture = Just $ ShaderTexture {_textureObject = textureOb}
|
||||
}
|
||||
|
||||
pokeTriStrat (RenderPoly vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
|
||||
pokeTriStrat _ = []
|
||||
@@ -91,39 +51,6 @@ pokeLineStrat _ = []
|
||||
pokeEllStrat (RenderEllipse vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
|
||||
pokeEllStrat _ = []
|
||||
|
||||
floatSize = sizeOf (0.5 :: GLfloat)
|
||||
|
||||
setupVAO :: [(GLuint,Int)] -> IO VAO
|
||||
setupVAO ps = do
|
||||
theVAO <- genObjectName
|
||||
bindVertexArrayObject $= Just theVAO
|
||||
vbos <- forM ps setupArrayBuffer
|
||||
ptrs <- forM (zip vbos $ map snd ps) setupVBOPointers
|
||||
return $ VAO theVAO ptrs
|
||||
|
||||
numDrawableElements :: Int
|
||||
numDrawableElements = 50000
|
||||
|
||||
setupVBOPointers :: (BufferObject,Int) -> IO (BufferObject,Ptr Float,Int)
|
||||
setupVBOPointers (vbo,vsize) = do
|
||||
thePtr <- mallocArray (vsize * numDrawableElements)
|
||||
return (vbo,thePtr,vsize)
|
||||
|
||||
setupArrayBuffer :: (GLuint,Int) -> IO BufferObject
|
||||
setupArrayBuffer (aloc,i) = do
|
||||
vbo <- genObjectName
|
||||
bindBuffer ArrayBuffer $= Just vbo
|
||||
vertexAttribPointer (AttribLocation aloc) $=
|
||||
( ToFloat
|
||||
, VertexArrayDescriptor (fromIntegral i)
|
||||
Float
|
||||
(fromIntegral $ floatSize * i)
|
||||
(bufferOffset 0)
|
||||
)
|
||||
vertexAttribArray (AttribLocation aloc) $= Enabled
|
||||
return vbo
|
||||
|
||||
|
||||
bufferOffset :: Integral a => a -> Ptr b
|
||||
bufferOffset = plusPtr nullPtr . fromIntegral
|
||||
|
||||
@@ -134,19 +61,20 @@ frag = FragmentShader
|
||||
preloadRender :: IO RenderData
|
||||
preloadRender = do
|
||||
-- compile shader programs
|
||||
lsShad <- makeShader "lightmapCircle" [vert,geom,frag] [(0,4)] Points (return . return . flat4)
|
||||
fcs <- makeSourcedShader "lightmapCircle" [VertexShader,GeometryShader,FragmentShader]
|
||||
bgs <- makeSourcedShader "background" [VertexShader,GeometryShader,FragmentShader]
|
||||
wss <- makeSourcedShader "wallShadow" [VertexShader,GeometryShader,FragmentShader]
|
||||
|
||||
wssLightPosUniLoc <- GL.uniformLocation (fst wss) "lightPos"
|
||||
|
||||
bslist <- makeShader "basic" [vert,frag] [(0,3),(1,4)] Triangles pokeTriStrat
|
||||
lslist <- makeShader "basic" [vert,frag] [(0,3),(1,4)] Lines pokeLineStrat
|
||||
bslist <- makeShader "basic" [vert,frag] [(0,3),(1,4)] Triangles pokeTriStrat
|
||||
lslist <- makeShader "basic" [vert,frag] [(0,3),(1,4)] Lines pokeLineStrat
|
||||
aslist <- makeShader "arc" [vert,geom,frag] [(0,3),(1,4),(2,3)] Points pokeArcStrat
|
||||
eslist <- makeShader "ellipse" [vert,geom,frag] [(0,3),(1,4)] Triangles pokeEllStrat
|
||||
cslist <- makeTextureShader "character" [vert,geom,frag]
|
||||
[(0,3),(1,4),(2,3)] Points pokeCharStrat
|
||||
"data/texture/charMap.png"
|
||||
aslist <- makeShader "arc" [vert,geom,frag] [(0,3),(1,4),(2,3)] Points pokeArcStrat
|
||||
eslist <- makeShader "ellipseInterpolate" [vert,geom,frag] [(0,3),(1,4)] Triangles pokeEllStrat
|
||||
|
||||
--the following vbo is set up to contain one fixed vertex
|
||||
dummyvbo <- genObjectName
|
||||
@@ -168,13 +96,11 @@ preloadRender = do
|
||||
generateMipmap' Texture2D
|
||||
textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
|
||||
|
||||
--textureBinding Texture2D $= Just chartex
|
||||
|
||||
-- input a list of (attribute location, attrib length) pairs
|
||||
-- these will have buffers and pointers created
|
||||
backgroundvao <- setupVAO [(0,4),(1,2)]
|
||||
wallvao <- setupVAO [(0,4),(1,4)]
|
||||
fadecircvao <- setupVAO [(0,4)]
|
||||
fadevao <- setupVAO [(0,4)]
|
||||
|
||||
return $ RenderData
|
||||
{ -- _charMap = convertRGBA8 cmap
|
||||
@@ -185,7 +111,7 @@ preloadRender = do
|
||||
, _wallShadowShader = wss
|
||||
, _backVAO = backgroundvao
|
||||
, _wallVAO = wallvao
|
||||
, _fadeCircVAO = fadecircvao
|
||||
, _fadeCircVAO = fadevao
|
||||
, _dummyVBO = dummyvbo
|
||||
, _dummyPtr = dummyptr
|
||||
, _wssLightPos = wssLightPosUniLoc
|
||||
|
||||
Reference in New Issue
Block a user