140 lines
5.5 KiB
Haskell
140 lines
5.5 KiB
Haskell
module Shader.AuxAddition
|
|
( addSamplerTexture2D
|
|
, vaddTextureNoFilter
|
|
, addTextureArray
|
|
, initTexture2D
|
|
, initTexture2DArray
|
|
, tilesToLine -- ^ kept in case it is needed in the future
|
|
) where
|
|
import Data.Preload.Render
|
|
import Unsafe.Coerce
|
|
import Shader.Data
|
|
import Data.List.Extra
|
|
import Codec.Picture
|
|
import qualified Data.Vector.Storable as VS
|
|
import Control.Lens
|
|
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 -> FullShader -> IO FullShader
|
|
addSamplerTexture2D = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR
|
|
|
|
vaddTextureNoFilter :: String -> FullShader -> IO FullShader
|
|
vaddTextureNoFilter = addTexture2D 1 GL_NEAREST GL_NEAREST
|
|
|
|
addTexture2D
|
|
:: GLint -- number of mipmap levels
|
|
-> GLenum -- minfilter
|
|
-> GLenum -- magfilter
|
|
-> String -- path to image
|
|
-> FullShader -> IO FullShader
|
|
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 & shadTex' ?~ ShaderTexture
|
|
{_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 }
|
|
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
|
|
|
|
-- 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
|
|
Right cmap <- readImage fp
|
|
let texdata = convertRGBA8 cmap
|
|
let wtex = fromIntegral $ imageWidth texdata
|
|
htex = fromIntegral $ imageHeight texdata
|
|
z = htex `div` wtex
|
|
checkGLError
|
|
putStrLn "x"
|
|
texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D_ARRAY
|
|
checkGLError
|
|
putStrLn "y"
|
|
glTextureStorage3D texname nlev GL_RGBA8 wtex wtex z
|
|
checkGLError
|
|
putStrLn "z"
|
|
VS.unsafeWith (imageData texdata) $ \ptr -> do
|
|
glTextureSubImage3D texname 0 0 0 0 wtex wtex z GL_RGBA GL_UNSIGNED_BYTE ptr
|
|
checkGLError
|
|
putStrLn "i"
|
|
glGenerateTextureMipmap texname
|
|
checkGLError
|
|
putStrLn "q"
|
|
glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
|
|
checkGLError
|
|
putStrLn "w"
|
|
glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
|
|
checkGLError
|
|
putStrLn "e"
|
|
return $ TO texname
|
|
|
|
-- | 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 -> (FullShader,VBO) -> IO (FullShader,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 & shadTex' ?~ ShaderTexture
|
|
{ _textureObject = texname}
|
|
, vbo)
|
|
|
|
-- I am completely unclear on why this works with its current parameters
|
|
tilesToLine
|
|
:: Int -- ^ Parameter a
|
|
-> Int -- ^ Parameter b
|
|
-> [a]
|
|
-> [a]
|
|
tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w
|