loop/src/Shader/AuxAddition.hs

module Shader.AuxAddition
    ( addSamplerTexture2D
    , vaddTextureNoFilter
    , addTextureArray
    , addBindTextureArray
    , initTexture2D
    , initTexture2DArray
    , tilesToLine
    ) where
import LensHelp
import Unsafe.Coerce
import Shader.Data
import Data.List.Extra
import Codec.Picture
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

-- 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
    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

-- | 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
    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 bindpoint texdata nlev w h d minfilt magfilt = do
    texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D_ARRAY
    glTextureStorage3D texname nlev GL_RGBA8 w h d
    VS.unsafeWith (imageData texdata) $ \ptr -> do
        glTextureSubImage3D texname 0 0 0 0 w h d GL_RGBA GL_UNSIGNED_BYTE ptr
        glGenerateTextureMipmap texname
        glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
        glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
        glBindTextureUnit bindpoint texname

tilesToLine 
    :: Int -- ^ Parameter a
    -> Int -- ^ Parameter b
    -> [a]
    -> [a]
tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w