module GLDraw where

import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import Foreign
import Graphics.Rendering.OpenGL as GL
import GLUtil

maxSquares, colorTableSize :: Int
maxSquares = 17
colorTableSize = maxSquares

vertexShaderSource :: BS.ByteString
vertexShaderSource = BS.pack
    "#version 440\n\
    \in vec2 pos; \n\
    \in uint colorID; \n\
    \in float alpha; \n\
    \flat out uint vcolorID; \n\
    \flat out float valpha; \n\
    \void main() {\n\
    \  gl_Position = vec4(pos.x, pos.y, 0.0, 1.0); \n\
    \  vcolorID = colorID; \n\
    \  valpha = alpha; \n\
    \}\n"

fragmentShaderSource :: BS.ByteString
fragmentShaderSource = BS.pack $
    "#version 440\n\
    \flat in uint vcolorID; \n\
    \flat in float valpha; \n\
    \uniform vec3[" ++ show colorTableSize ++ "] colorTable; \n\
    \out vec4 color; \n\
    \void main() {\n\
    \   color = vec4(colorTable[vcolorID], valpha); \n\
    \}\n"

data GLResources = GLResources
    { program           :: Program
    , positionAttr      :: AttribLocation
    , colorIDAttr       :: AttribLocation
    , alphaAttr         :: AttribLocation
    , colorTableUnif    :: UniformLocation
    , vertexBuf         :: BufferObject
    , squareElemBuf     :: BufferObject
    }

initShaders :: IO Program
initShaders = do
    vertexShader <- compileShaderSource VertexShader vertexShaderSource
    fragmentShader <- compileShaderSource FragmentShader fragmentShaderSource
    createProgram' [vertexShader, fragmentShader]

initSquareElements :: IO BufferObject
initSquareElements = do
    elemBufObj <- genObjectName
    setBufferData elemBufObj ElementArrayBuffer StaticDraw
        [4*n+m :: GLushort | n <- [0..fromIntegral maxSquares - 1], m <- [0,1,2,3,2,1]]
    return elemBufObj

makeGLResources :: IO GLResources
makeGLResources = do
    prog <- initShaders
    GLResources <$> pure prog
        <*> GL.get (attribLocation prog "pos")
        <*> GL.get (attribLocation prog "colorID")
        <*> GL.get (attribLocation prog "alpha")
        <*> GL.get (uniformLocation prog "colorTable")
        <*> genObjectName
        <*> initSquareElements

updateColorTable :: GLResources -> [Color3 GLfloat] -> IO ()
updateColorTable glRes colors = do
    currentProgram $= Just (program glRes)
    withArray colors $ \ptr ->
        uniformv (colorTableUnif glRes) (fromIntegral $ length colors) ptr
    currentProgram $= Nothing

-- --- ----- -------

data PrimVertex = PrimVertex !GLfloat !GLfloat !GLfloat !GLushort

primVertexFieldSizes :: [Int]
primVertexFieldSizes = [sizeOf x, sizeOf y, sizeOf a, sizeOf ci]
    where PrimVertex x y a ci = undefined

primVertexFieldOffsets :: [Int]
primVertexFieldOffsets = scanl (+) 0 primVertexFieldSizes

instance Storable PrimVertex where
    sizeOf _ = sum primVertexFieldSizes
    alignment _  = alignment (0 :: GLfloat)
    peek ptr = PrimVertex <$> p 0 <*> p 1 <*> p 2 <*> p 3
        where p n = peekByteOff ptr (primVertexFieldOffsets !! n)
    poke ptr (PrimVertex x y a ci) = do
        let p n = pokeByteOff ptr (primVertexFieldOffsets !! n)
        p 0 x
        p 1 y
        p 2 a
        p 3 ci

primVertexStride :: Stride
primVertexStride = fromIntegral $ sizeOf (undefined :: PrimVertex)

positionVAD :: VertexArrayDescriptor a
positionVAD = VertexArrayDescriptor 2 Float primVertexStride offset0

colorIDVAD :: VertexArrayDescriptor a
colorIDVAD = VertexArrayDescriptor 1 UnsignedShort primVertexStride (plusPtr offset0 (primVertexFieldOffsets !! 3))

alphaVAD :: VertexArrayDescriptor a
alphaVAD = VertexArrayDescriptor 1 Float primVertexStride (plusPtr offset0 (primVertexFieldOffsets !! 2))

-- --- ----- -------

data PrimSquare = PrimSquare !GLfloat !GLfloat !GLfloat !GLfloat !GLushort

drawSquares :: GLResources -> [PrimSquare] -> IO ()
drawSquares glRes sqs = do
    let verts = [ PrimVertex (x + dx) (y + dy) a ci |
            (PrimSquare x y sz a ci) <- sqs, dx <- [sz, -sz], dy <- [sz, -sz]]

    setBufferData (vertexBuf glRes) ArrayBuffer StreamDraw verts

    bindBuffer ArrayBuffer $= Just (vertexBuf glRes)
    vertexAttribPointer (positionAttr glRes) $= (ToFloat, positionVAD)
    vertexAttribPointer (colorIDAttr glRes) $= (KeepIntegral, colorIDVAD)
    vertexAttribPointer (alphaAttr glRes) $= (ToFloat, alphaVAD)
    bindBuffer ArrayBuffer $= Nothing

    currentProgram $= Just (program glRes)
    vertexAttribArray (positionAttr glRes) $= Enabled
    vertexAttribArray (colorIDAttr glRes) $= Enabled
    vertexAttribArray (alphaAttr glRes) $= Enabled
    bindBuffer ElementArrayBuffer $= Just (squareElemBuf glRes)
    drawElements Triangles (fromIntegral $ 6 * length sqs) UnsignedShort offset0
    bindBuffer ElementArrayBuffer $= Nothing
    vertexAttribArray (positionAttr glRes) $= Disabled
    vertexAttribArray (colorIDAttr glRes) $= Disabled
    vertexAttribArray (alphaAttr glRes) $= Disabled
    currentProgram $= Nothing
