module Shader.AuxAddition
    ( addTexture
    , addTextureNoFilter
    , vaddTextureNoFilter
    , addTextureArray
    , addUniforms
    , tilesToLine -- ^ kept in case it is needed in the future
    ) where
import Shader.Data

import Data.List.Extra
import Codec.Picture
import qualified Data.Vector.Storable as V
import Control.Lens
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
import Graphics.GL.Core43
    
-- I am not sure if this assumes that the shader is constructed directly before
-- the texture is added...
addTexture :: String -> FullShader -> IO FullShader
addTexture texturePath shad = do
    Right cmap <- readImage texturePath
    let tex = convertRGBA8 cmap
    textureOb <- genObjectName
    textureBinding Texture2D $= Just textureOb
    let wtex = fromIntegral $ imageWidth  tex
        htex = fromIntegral $ imageHeight tex
    glTexStorage2D GL_TEXTURE_2D 3 GL_RGBA8 wtex htex
    V.unsafeWith (imageData tex) $ \ptr -> do
        glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
    textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
    generateMipmap' Texture2D
    return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}

vaddTextureNoFilter :: String -> FullShader -> IO FullShader
vaddTextureNoFilter texturePath shad = do
    Right cmap <- readImage texturePath
    let tex = convertRGBA8 cmap
    textureOb <- genObjectName
    textureBinding Texture2D $= Just textureOb
    textureFilter Texture2D $= ((Nearest,Nothing) , Nearest)
    let wtex = fromIntegral $ imageWidth  tex
        htex = fromIntegral $ imageHeight tex
    glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
    V.unsafeWith (imageData tex) $ \ptr -> do
        glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
    return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}

addTextureNoFilter :: String -> FullShader -> IO FullShader
addTextureNoFilter texturePath shad = do
    Right cmap <- readImage texturePath
    let tex = convertRGBA8 cmap
    textureOb <- genObjectName
    textureBinding Texture2D $= Just textureOb
    textureFilter Texture2D $= ((Nearest,Nothing) , Nearest)
    let wtex = fromIntegral $ imageWidth  tex
        htex = fromIntegral $ imageHeight tex
    glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
    V.unsafeWith (imageData tex) $ \ptr -> do
        glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
    return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}

-- | 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 -> IO FullShader
addTextureArray texturePath shad = do
    textureOb <- genObjectName
    textureBinding Texture2DArray $= Just textureOb
    Right cmap <- readImage texturePath
    let tex = convertRGBA8 cmap
    --let texData = tilesToLine 8 128 . 
    --let texData = tilesToLine 8 128 . 
    --        V.toList $ imageData tex
    glTexStorage3D GL_TEXTURE_2D_ARRAY 3 GL_RGBA8 32 32 64
    --writePng "atest.png" ((Image 256 256 (V.fromList texData)) :: Image PixelRGBA8)
    --withArray texData $ \ptr -> do
    V.unsafeWith (imageData tex) $ \ptr -> do
        --glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
        glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
    textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
    generateMipmap' Texture2DArray
    return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}

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

addUniforms :: [String] -> FullShader -> IO FullShader
addUniforms uniStrings shad = do
    uniLocs <- mapM (uniformLocation $ _shadProg shad) uniStrings
    return $ shad & shadUnis %~ (++ uniLocs)