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

Work on textures and lighting

Browse Source
This commit is contained in:
justin
2023-03-23 21:17:24 +00:00
parent 1a2fc7c715
commit 1abfaa3cd0
25 changed files with 641 additions and 710 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader/AuxAddition.hs
+49 -117
View File
@@ -1,128 +1,58 @@
module Shader.AuxAddition
( addSamplerTexture2D
, vaddTextureNoFilter
, addTextureArray
, addBindTextureArray
, initTexture2D
, initTexture2DArray
, tilesToLine
) where
import LensHelp
import Unsafe.Coerce
import Shader.Data
import Data.List.Extra
module Shader.AuxAddition (
initTexture2DArray,
initTexture2DArraySquare,
tilesToLine,
) where
import Codec.Picture
import Data.List.Extra
import qualified Data.Vector.Storable as VS
import Graphics.GL.Core45
import GLHelp
-- I am not sure if this assumes that the shader is constructed directly before
-- the texture is added...
addSamplerTexture2D :: String -> Shader -> IO Shader
addSamplerTexture2D = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR
vaddTextureNoFilter :: String -> Shader -> IO Shader
vaddTextureNoFilter = addTexture2D 1 GL_NEAREST GL_NEAREST
addTexture2D
:: GLint -- number of mipmap levels
-> GLenum -- minfilter
-> GLenum -- magfilter
-> String -- path to image
-> Shader -> IO Shader
addTexture2D nlev minfilt magfilt texpath shad = do
Right cmap <- readImage texpath
let texdata = convertRGBA8 cmap
let wtex = fromIntegral $ imageWidth texdata
htex = fromIntegral $ imageHeight texdata
texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D
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 & shaderTextures .:~ TO 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 }
initTexture2D
:: GLint -- number of mipmap levels
-> GLenum -- minfilter
-> GLenum -- magfilter
-> String -> IO TO
initTexture2D nlev minfilt magfilt fp = do
Right cmap <- readImage fp
let texdata = convertRGBA8 cmap
let wtex = fromIntegral $ imageWidth texdata
htex = fromIntegral $ imageHeight texdata
texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D
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 $ TO texname
import Graphics.GL.Core45
import Unsafe.Coerce
-- assumes the texture slices are squares with sides as long as the input is
-- wide
initTexture2DArray
:: GLint -- number of mipmap levels
-> GLenum -- minfilter
-> GLenum -- magfilter
-> String -> IO TO
initTexture2DArray nlev minfilt magfilt fp = do
initTexture2DArraySquare ::
GLuint -> -- binding point
GLint -> -- number of mipmap levels
GLenum -> -- minfilter
GLenum -> -- magfilter
String ->
IO ()
initTexture2DArraySquare bindpoint nlev minfilt magfilt fp = do
Right cmap <- readImage fp
let texdata = convertRGBA8 cmap
let wtex = fromIntegral $ imageWidth texdata
htex = fromIntegral $ imageHeight texdata
z = htex `div` wtex
texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D_ARRAY
glTextureStorage3D texname nlev GL_RGBA8 wtex wtex z
VS.unsafeWith (imageData texdata) $ \ptr -> do
glTextureSubImage3D texname 0 0 0 0 wtex wtex z 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 $ TO texname
let sqside = fromIntegral $ imageWidth texdata
totalh = fromIntegral $ imageHeight texdata
d = totalh `div` sqside
initTexture2DArrayData bindpoint texdata nlev sqside sqside d minfilt magfilt
-- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into
-- an image that was directly readable by glTexSubImage3D, used the
-- transformation tilesToLine 8 128 on the underlying pixels.
addTextureArray :: String -> (Shader,VBO) -> IO (Shader,VBO)
addTextureArray texturePath (shad,vbo) = do
err <- glGetError
print err
Right cmap <- readImage texturePath
let texdata = convertRGBA8 cmap
texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D_ARRAY
glTextureStorage3D texname 3 GL_RGBA8 32 32 64
VS.unsafeWith (imageData texdata) $ \ptr -> do
glTextureSubImage3D texname 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
glGenerateTextureMipmap texname
glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_LINEAR_MIPMAP_LINEAR)
glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_LINEAR)
return (shad & shaderTextures .:~ TO texname
, vbo)
addBindTextureArray :: GLuint -> String -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> GLenum -> GLenum
-> IO ()
addBindTextureArray bindpoint fp nlev w h d minfilt magfilt = do
initTexture2DArray ::
GLuint ->
String ->
GLsizei ->
GLsizei ->
GLsizei ->
GLsizei ->
GLenum ->
GLenum ->
IO ()
initTexture2DArray bindpoint fp nlev w h d minfilt magfilt = do
Right cmap <- readImage fp
let texdata = convertRGBA8 cmap
initTexture2DArrayData bindpoint texdata nlev w h d minfilt magfilt
initTexture2DArrayData :: GLuint -> Image PixelRGBA8 -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> GLenum -> GLenum
-> IO ()
initTexture2DArrayData ::
GLuint ->
Image PixelRGBA8 ->
GLsizei ->
GLsizei ->
GLsizei ->
GLsizei ->
GLenum ->
GLenum ->
IO ()
initTexture2DArrayData bindpoint texdata nlev w h d minfilt magfilt = do
texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D_ARRAY
glTextureStorage3D texname nlev GL_RGBA8 w h d
@@ -133,9 +63,11 @@ initTexture2DArrayData bindpoint texdata nlev w h d minfilt magfilt = do
glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
glBindTextureUnit bindpoint texname
tilesToLine
:: Int -- ^ Parameter a
-> Int -- ^ Parameter b
-> [a]
-> [a]
tilesToLine ::
-- | Parameter a
Int ->
-- | Parameter b
Int ->
[a] ->
[a]
tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w
src/Shader/Compile.hs
+60 -79
View File
@@ -2,9 +2,8 @@ module Shader.Compile (
setupVBO,
setupVBOStatic,
makeShaderEBO,
makeShader,
makeShader4,
makeShader4UsingVAO,
makeShaderVBO,
makeShaderUsingVBO,
makeByteStringShaderUsingVAO,
makeShaderSized,
makeShaderUsingVAO,
@@ -25,13 +24,14 @@ import GLHelp
import Graphics.GL.Core45
import Shader.Data
import Shader.Parameters
--import Graphics.GL.Core45
{- |
Compiles a full shader found within the shader directory.
The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
-}
makeShader ::
makeShaderVBO ::
-- | First part of the name of the shader
String ->
-- | shader types
@@ -39,17 +39,18 @@ makeShader ::
-- | The input vertex sizes
[Int] ->
PrimitiveMode ->
IO (Shader,VBO)
makeShader s shaderlist sizes pm = do
IO (Shader, VBO)
makeShaderVBO s shaderlist sizes pm = do
prog <- makeSourcedShader s shaderlist
(vao,vbo) <- setupVAO sizes
return ( Shader
(vao, vbo) <- setupVAO sizes
return
( Shader
{ _shaderUINT = prog
, _shaderVAO = vao
, _shaderPrimitive = pm
, _shaderTextures = mempty
}
, vbo)
, vbo
)
makeShaderEBO ::
-- | First part of the name of the shader
@@ -68,11 +69,11 @@ makeShaderEBO s shaderlist sizes strd pm vbo = do
vao <- setupVAOvbo sizes strd vbo
ebo <- setupEBO vao
return
( Shader prog pm vao []
( Shader prog pm vao
, ebo
)
makeShader4 ::
makeShaderUsingVBO ::
-- | First part of the name of the shader
String ->
-- | shader types
@@ -84,54 +85,32 @@ makeShader4 ::
PrimitiveMode ->
VBO ->
IO Shader
makeShader4 s shaderlist sizes strd pm vbo = do
prog <- makeSourcedShader s shaderlist
vao <- setupVAOvbo sizes strd vbo
return $ Shader
{ _shaderUINT = prog
, _shaderVAO = vao
, _shaderPrimitive = pm
, _shaderTextures = mempty
}
makeShader4UsingVAO ::
-- | First part of the name of the shader
String ->
-- | shader types
[GLenum] ->
PrimitiveMode ->
VAO ->
IO Shader
makeShader4UsingVAO s shaderlist pm vao = do
prog <- makeSourcedShader s shaderlist
return $ Shader
{ _shaderUINT = prog
, _shaderVAO = vao
, _shaderPrimitive = pm
, _shaderTextures = []
}
makeShaderUsingVBO s shaderlist sizes strd pm vbo = setupVAOvbo sizes strd vbo
>>= makeShaderUsingVAO s shaderlist pm
setupVBO :: Int -> IO VBO
setupVBO vertexsize = do
vboname <- mglCreate glCreateBuffers
thePtr <- mallocArray (vertexsize * numDrawableElements)
-- Allocate space
glNamedBufferData vboname
( fromIntegral $ floatSize * numDrawableElements * vertexsize)
nullPtr
glNamedBufferData
vboname
(fromIntegral $ floatSize * numDrawableElements * vertexsize)
nullPtr
GL_STREAM_DRAW
return VBO {_vboName = vboname, _vboPtr = thePtr, _vboVertexSize = vertexsize}
return VBO{_vboName = vboname, _vboPtr = thePtr, _vboVertexSize = vertexsize}
setupVBOStatic :: Int -> IO VBO
setupVBOStatic vertexsize = do
vboname <- mglCreate glCreateBuffers
thePtr <- mallocArray (vertexsize * numDrawableElements)
-- Allocate space
glNamedBufferData vboname
( fromIntegral $ floatSize * numDrawableElements * vertexsize)
nullPtr
glNamedBufferData
vboname
(fromIntegral $ floatSize * numDrawableElements * vertexsize)
nullPtr
GL_STATIC_DRAW
return VBO {_vboName = vboname, _vboPtr = thePtr, _vboVertexSize = vertexsize}
return VBO{_vboName = vboname, _vboPtr = thePtr, _vboVertexSize = vertexsize}
makeByteStringShaderUsingVAO ::
-- | (Arbitrary) name of the shader
@@ -143,12 +122,11 @@ makeByteStringShaderUsingVAO ::
IO Shader
makeByteStringShaderUsingVAO s shaderlist pm vao = do
prog <- makeShaderProgram s shaderlist
return $
return
Shader
{ _shaderUINT = prog
, _shaderVAO = vao
, _shaderPrimitive = pm
, _shaderTextures = mempty
}
-- | Takes the VAO from elsewhere
@@ -162,12 +140,11 @@ makeShaderUsingVAO ::
IO Shader
makeShaderUsingVAO s shaderlist pm theVAO = do
prog <- makeSourcedShader s shaderlist
return $
return
Shader
{ _shaderUINT = prog
, _shaderVAO = theVAO
, _shaderPrimitive = pm
, _shaderTextures = mempty
}
{- |
@@ -184,17 +161,18 @@ makeShaderSized ::
-- | Number of vertexes that can be poked
Int ->
PrimitiveMode ->
IO (Shader,VBO)
IO (Shader, VBO)
makeShaderSized s shaderlist sizes ndraw pm = do
prog <- makeSourcedShader s shaderlist
(vao,vbo) <- setupVAOSized ndraw sizes
return ( Shader
(vao, vbo) <- setupVAOSized ndraw sizes
return
( Shader
{ _shaderUINT = prog
, _shaderVAO = vao
, _shaderPrimitive = pm
, _shaderTextures = mempty
}
, vbo)
, vbo
)
{- | Compile shader and get its uniform locations.
supposes the shader code is in the shader folder, with the string names
@@ -202,17 +180,17 @@ makeShaderSized s shaderlist sizes ndraw pm = do
-}
makeSourcedShader :: String -> [GLenum] -> IO GLuint
makeSourcedShader s sts = do
sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt' st)
sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt st)
makeShaderProgram s $ zip sts sources
shaderTypeExt' :: GLenum -> String
shaderTypeExt' GL_VERTEX_SHADER = ".vert"
shaderTypeExt' GL_GEOMETRY_SHADER = ".geom"
shaderTypeExt' GL_FRAGMENT_SHADER = ".frag"
shaderTypeExt' _ = undefined
shaderTypeExt :: GLenum -> String
shaderTypeExt GL_VERTEX_SHADER = ".vert"
shaderTypeExt GL_GEOMETRY_SHADER = ".geom"
shaderTypeExt GL_FRAGMENT_SHADER = ".frag"
shaderTypeExt _ = undefined
-- I think that this requires that the correct shader program is bound?
setupVAO :: [Int] -> IO (VAO,VBO)
setupVAO :: [Int] -> IO (VAO, VBO)
setupVAO = setupVAOSized numDrawableElements
setupVAOvbo' :: [Int] -> Int -> GLuint -> IO VAO
@@ -220,17 +198,18 @@ setupVAOvbo' sizes strd vbo = do
vaoname <- mglCreate glCreateVertexArrays
glBindVertexArray vaoname
setupVertexAttribs' vbo vaoname sizes strd
return $ VAO
return $
VAO
{ _vaoName = vaoname
}
setupVAOvbo :: [Int] -> Int -> VBO -> IO VAO
setupVAOvbo sizes strd vbo = do
vaoname <- mglCreate glCreateVertexArrays
glBindVertexArray vaoname
setupVertexAttribs vbo vaoname sizes strd
return $ VAO
return $
VAO
{ _vaoName = vaoname
}
@@ -238,37 +217,40 @@ setupEBO :: VAO -> IO EBO
setupEBO vao = do
eboptr <- mallocArray numDrawableElements
eboname <- mglCreate glCreateBuffers
glNamedBufferData
glNamedBufferData
eboname
( fromIntegral $ glushortSize * numDrawableElements)
nullPtr
(fromIntegral $ glushortSize * numDrawableElements)
nullPtr
GL_STREAM_DRAW
glVertexArrayElementBuffer (vao ^. vaoName) eboname
return $ EBO eboname eboptr
setupVAOSized :: Int -> [Int] -> IO (VAO,VBO)
setupVAOSized :: Int -> [Int] -> IO (VAO, VBO)
setupVAOSized ndraw sizes = do
vaoname <- mglCreate glCreateVertexArrays
glBindVertexArray vaoname
theVBO <- setupVBOSized ndraw vaoname sizes
return ( VAO
return
( VAO
{ _vaoName = vaoname
}
, theVBO)
, theVBO
)
setupVBOSized :: Int -> GLuint -> [Int] -> IO VBO
setupVBOSized ndraw vao sizes = do
--vboName <- genObjectName
--bindBuffer ArrayBuffer $= Just vboName
vboname <- mglCreate glCreateBuffers
glVertexArrayVertexBuffer vao 0 vboname 0 (fromIntegral $ floatSize * strd)
glVertexArrayVertexBuffer vao 0 vboname 0 (fromIntegral $ floatSize * strd)
forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
setupVertexAttribPointer vao loc siz off
thePtr <- mallocArray (strd * ndraw)
-- Allocate space
glNamedBufferData vboname
( fromIntegral $ floatSize * ndraw * strd)
nullPtr
glNamedBufferData
vboname
(fromIntegral $ floatSize * ndraw * strd)
nullPtr
GL_STREAM_DRAW
return $
VBO
@@ -282,7 +264,7 @@ setupVBOSized ndraw vao sizes = do
setupVertexAttribs :: VBO -> GLuint -> [Int] -> Int -> IO ()
setupVertexAttribs vbo vao sizes strd = do
glVertexArrayVertexBuffer vao 0 (_vboName vbo) 0 (fromIntegral $ floatSize * strd)
glVertexArrayVertexBuffer vao 0 (_vboName vbo) 0 (fromIntegral $ floatSize * strd)
forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
setupVertexAttribPointer vao loc siz off
where
@@ -290,7 +272,7 @@ setupVertexAttribs vbo vao sizes strd = do
setupVertexAttribs' :: GLuint -> GLuint -> [Int] -> Int -> IO ()
setupVertexAttribs' vbo vao sizes strd = do
glVertexArrayVertexBuffer vao 0 vbo 0 (fromIntegral $ floatSize * strd)
glVertexArrayVertexBuffer vao 0 vbo 0 (fromIntegral $ floatSize * strd)
forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
setupVertexAttribPointer vao loc siz off
where
@@ -356,7 +338,7 @@ compileAndCheckShader str (theShaderType, sourceCode) = do
setShaderSource theShader sourceCode
glCompileShader theShader
checkErrorGL
(str ++ shaderTypeExt' theShaderType)
(str ++ shaderTypeExt theShaderType)
glGetShaderiv
glGetShaderInfoLog
theShader
@@ -375,4 +357,3 @@ withByteString :: Num t => BS.ByteString -> (Ptr b -> t -> IO a) -> IO a
withByteString bs act =
BU.unsafeUseAsCStringLen bs $ \(ptr, size) ->
act (castPtr ptr) (fromIntegral size)
src/Shader/Data.hs
-2
View File
@@ -16,7 +16,6 @@ module Shader.Data (
shaderUINT,
shaderPrimitive,
shaderVAO,
shaderTextures,
textureObject,
vboName,
vboPtr,
@@ -51,7 +50,6 @@ data Shader = Shader
{ _shaderUINT :: GLuint -- should be shaderID
, _shaderPrimitive :: PrimitiveMode
, _shaderVAO :: VAO
, _shaderTextures :: [TO]
}
newtype FBO = FBO {_unFBO :: GLuint}
src/Shader/Poke.hs
+4 -4
View File
@@ -10,7 +10,7 @@ module Shader.Poke (
import Geometry.Vector
import Dodge.Data.Wall
import Shader.Poke.Triangulate
import Geometry.Triangulate
import Control.Monad.Primitive
import qualified Data.Vector as V
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
@@ -257,7 +257,7 @@ pokeIndex nv eiptr ni ioff = do
memoFlatIndices :: V.Vector (UV.Vector Int)
memoFlatIndices =
V.generate 10 $
UV.fromList . concatMap triangulate . boxSurfaces' . (+ 3)
UV.fromList . concatMap polyToTris . boxSurfaces' . (+ 3)
memoTopPrismIndices :: V.Vector (UV.Vector Int)
{-# INLINE memoTopPrismIndices #-}
@@ -313,8 +313,8 @@ boxEdgeIndices n = concatMap f [0 .. n -1]
cylinderIndices :: Int -> [Int]
cylinderIndices n =
cylinderRoundIndices n
++ triangulate [2 * n, 2 * n + 2 .. 4 * n - 1]
++ triangulate [2 * n + 1, 2 * n + 3 .. 4 * n - 1]
++ polyToTris [2 * n, 2 * n + 2 .. 4 * n - 1]
++ polyToTris [2 * n + 1, 2 * n + 3 .. 4 * n - 1]
cylinderRoundIndices :: Int -> [Int]
cylinderRoundIndices n =
src/Shader/Poke/Floor.hs
+10 -11
View File
@@ -1,22 +1,21 @@
module Shader.Poke.Floor
( pokeTile
) where
module Shader.Poke.Floor (
pokeTile,
) where
import Geometry
import Shader.Poke.Triangulate
import Control.Monad
import Tile
import Data.Tile
import Foreign
import Geometry
import Tile
pokeTile :: Ptr Float -> Int -> Tile -> IO Int
pokeTile ptr i t@Tile { _tilePoly = ps } = do
foldM (pokeTileVerx ttan (_tileArrayZ t) ptr) i $ triangulate $ zip ps (tileTexCoords t)
pokeTile ptr i t@Tile{_tilePoly = ps} = do
foldM (pokeTileVerx ttan (_tileArrayZ t) ptr) i $ polyToTris $ zip ps (tileTexCoords t)
where
ttan = _tileTangentPos t - _tileZero t
pokeTileVerx :: Point2 -> Float -> Ptr Float -> Int -> (Point2,Point2) -> IO Int
pokeTileVerx tangent tilez ptr i (V2 x y,V2 s t) = do
pokeTileVerx :: Point2 -> Float -> Ptr Float -> Int -> (Point2, Point2) -> IO Int
pokeTileVerx tangent tilez ptr i (V2 x y, V2 s t) = do
let a = argV tangent
zipWithM_ (\off -> pokeElemOff ptr (i*8 + off)) [0..] [x,y,1,1,s,t,tilez,a]
zipWithM_ (\off -> pokeElemOff ptr (i * 8 + off)) [0 ..] [x, y, 1, 1, s, t, tilez, a]
return $ i + 1
src/Shader/Poke/Triangulate.hs
-15
View File
@@ -1,15 +0,0 @@
module Shader.Poke.Triangulate where
import qualified Data.Vector as V
triangulate :: [a] -> [a]
{-# INLINE triangulate #-}
triangulate is = V.toList . V.backpermute (V.fromList is) . V.fromList $ triangulateIndices (length is)
triangulateIndices :: Int -> [Int]
{-# INLINE triangulateIndices #-}
triangulateIndices i = concatMap f [0 .. i -3]
where
f x
| even x = [0, x + 1, x + 2]
| otherwise = [0, x + 2, x + 1]