justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Continue move to raw open gl

Browse Source
This commit is contained in:
justin
2023-03-09 09:52:55 +00:00
parent 48966dde1a
commit b8fbc6055d
2 changed files with 41 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader/AuxAddition.hs
+15 -8
View File
@@ -6,8 +6,6 @@ module Shader.AuxAddition
, tilesToLine -- ^ kept in case it is needed in the future , tilesToLine -- ^ kept in case it is needed in the future
) where ) where
import Unsafe.Coerce import Unsafe.Coerce
import Foreign.Marshal
import Foreign.Storable
import Shader.Data import Shader.Data
import Control.Monad import Control.Monad
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
@@ -19,6 +17,7 @@ import qualified Data.Vector.Storable as VS
import Control.Lens import Control.Lens
--import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) --import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
import Graphics.GL.Core45 import Graphics.GL.Core45
import GLHelp
-- I am not sure if this assumes that the shader is constructed directly before -- I am not sure if this assumes that the shader is constructed directly before
-- the texture is added... -- the texture is added...
@@ -39,9 +38,7 @@ addTexture2D nlev minfilt magfilt texpath shad = do
let texdata = convertRGBA8 cmap let texdata = convertRGBA8 cmap
let wtex = fromIntegral $ imageWidth texdata let wtex = fromIntegral $ imageWidth texdata
htex = fromIntegral $ imageHeight texdata htex = fromIntegral $ imageHeight texdata
alloca $ \nameptr -> do texname <- mglCreateSingle $ glCreateTextures GL_TEXTURE_2D 1
glCreateTextures GL_TEXTURE_2D 1 nameptr
texname <- peek nameptr
glTextureStorage2D texname nlev GL_RGBA8 wtex htex glTextureStorage2D texname nlev GL_RGBA8 wtex htex
VS.unsafeWith (imageData texdata) $ \ptr -> do VS.unsafeWith (imageData texdata) $ \ptr -> do
glTextureSubImage2D texname 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr glTextureSubImage2D texname 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
@@ -50,6 +47,18 @@ addTexture2D nlev minfilt magfilt texpath shad = do
glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt) glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
return $ shad & shadTex' ?~ ShaderTexture return $ shad & shadTex' ?~ ShaderTexture
{_textureObject = texname } {_textureObject = texname }
-- alloca $ \nameptr -> do
-- glCreateTextures GL_TEXTURE_2D 1 nameptr
-- texname <- peek nameptr
-- glTextureStorage2D texname nlev GL_RGBA8 wtex htex
-- VS.unsafeWith (imageData texdata) $ \ptr -> do
-- glTextureSubImage2D texname 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
-- glGenerateTextureMipmap texname
-- glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
-- glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
-- return $ shad & shadTex' ?~ ShaderTexture
-- {_textureObject = texname }
-- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into -- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into
-- an image that was directly readable by glTexSubImage3D, used the -- an image that was directly readable by glTexSubImage3D, used the
@@ -60,9 +69,7 @@ addTextureArray texturePath shad = do
print err print err
Right cmap <- readImage texturePath Right cmap <- readImage texturePath
let texdata = convertRGBA8 cmap let texdata = convertRGBA8 cmap
alloca $ \nameptr -> do texname <- mglCreateSingle $ glCreateTextures GL_TEXTURE_2D_ARRAY 1
glCreateTextures GL_TEXTURE_2D_ARRAY 1 nameptr
texname <- peek nameptr
glTextureStorage3D texname 3 GL_RGBA8 32 32 64 glTextureStorage3D texname 3 GL_RGBA8 32 32 64
VS.unsafeWith (imageData texdata) $ \ptr -> do VS.unsafeWith (imageData texdata) $ \ptr -> do
glTextureSubImage3D texname 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr glTextureSubImage3D texname 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
src/Shader/Compile.hs
+9 -4
View File
@@ -226,12 +226,12 @@ makeShaderProgram str srcs = do
shaders <- mapM (compileAndCheckShader str) srcs shaders <- mapM (compileAndCheckShader str) srcs
mapM_ (glAttachShader theprog) shaders mapM_ (glAttachShader theprog) shaders
glLinkProgram theprog glLinkProgram theprog
glCheckError (str ++ " linking ") glGetProgramiv glGetProgramInfoLog theprog GL_LINK_STATUS checkErrorGL (str ++ " linking ") glGetProgramiv glGetProgramInfoLog theprog GL_LINK_STATUS
mapM_ (glDetachShader theprog) shaders mapM_ (glDetachShader theprog) shaders
mapM_ glDeleteShader shaders mapM_ glDeleteShader shaders
return theprog return theprog
glCheckError :: checkErrorGL ::
(Storable t1) => (Storable t1) =>
[Char] -> [Char] ->
(t2 -> GLenum -> Ptr t1 -> IO ()) -> (t2 -> GLenum -> Ptr t1 -> IO ()) ->
@@ -239,7 +239,7 @@ glCheckError ::
t2 -> t2 ->
GLenum -> GLenum ->
IO () IO ()
glCheckError str f g x statustype = checkErrorGL str f g x statustype =
alloca $ \statusPtr -> do alloca $ \statusPtr -> do
f x statustype statusPtr f x statustype statusPtr
status <- peek $ castPtr statusPtr status <- peek $ castPtr statusPtr
@@ -257,7 +257,12 @@ compileAndCheckShader str (theShaderType, sourceCode) = do
theShader <- glCreateShader theShaderType theShader <- glCreateShader theShaderType
setShaderSource theShader sourceCode setShaderSource theShader sourceCode
glCompileShader theShader glCompileShader theShader
glCheckError (str ++ shaderTypeExt' theShaderType) glGetShaderiv glGetShaderInfoLog theShader GL_COMPILE_STATUS checkErrorGL
(str ++ shaderTypeExt' theShaderType)
glGetShaderiv
glGetShaderInfoLog
theShader
GL_COMPILE_STATUS
return theShader return theShader
setShaderSource :: GLuint -> BS.ByteString -> IO () setShaderSource :: GLuint -> BS.ByteString -> IO ()