{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
 - Module      : Haskengl.Internal.IO.Shaders.Init
 - Description : Initialises Shaders, Textures, ...
 - Copyright   : Andromeda 2025
 - License     : WTFPL
 - Maintainer  : Matrix @Andromeda:tchncs.de
 - Stability   : Experimental
 -}
module Haskengl.Internal.IO.Shaders.Init where

import Relude

import qualified Language.GLSL as GLSL
import qualified Linear        as L
import           Linear.V4             (V4(..))

import Data.Text (unpack)

import Foreign.Ptr
import Foreign.Marshal.Array
import Foreign.Storable

import qualified Haskengl.Internal.Bindings.OpenGL as GL
import           Haskengl.Internal.Bindings.OpenGL         (($=))
import qualified Haskengl.Internal.Bindings.GLFW   as GLFW
import qualified Haskengl.Internal.Bindings.GLUtil as GLU
import           Haskengl.Internal.IO.Shaders.LoadShaders
import           Haskengl.Internal.IO.Shaders.Shaders
import           Haskengl.Internal.Types
import           Haskengl.Internal.Math.Classes

-- | magic ptr stuff
bufferOffset :: Integral a => a -> Ptr b
bufferOffset integral = plusPtr nullPtr $ fromIntegral integral

-- | should move to Haskengl.Internal.Math probably
toGLMatrix :: L.M44 GL.GLfloat -> [GL.GLfloat]
toGLMatrix (V4 (V4 c00 c01 c02 c03)
                  (V4 c10 c11 c12 c13)
                  (V4 c20 c21 c22 c23)
                  (V4 c30 c31 c32 c33)) =
  [ c00, c01, c02, c03
  , c10, c11, c12, c13
  , c20, c21, c22, c23
  , c30, c31, c32, c33
  ]

-- | random test shape with a more serious name
verticesArray :: [GL.Vertex3 GL.GLfloat]
verticesArray =
  [ GL.Vertex3 0.3    0.3    0.5
  , GL.Vertex3 (-0.3) 0.3    0
  , GL.Vertex3 0.3    (-0.3) 0
  , GL.Vertex3 (-0.3) (-0.3) (-0.5)
  ]

-- | random test shape
testArray :: [GL.Vertex3 GL.GLfloat]
testArray =
  [ GL.Vertex3 1.5 1.5 0
  , GL.Vertex3 0.5 1.5 0
  , GL.Vertex3 1.5 0.5 0
  , GL.Vertex3 0.5 0.5 0
  ]

-- | uv array for a square
verticesUVArray :: [GL.Vertex2 GL.GLfloat]
verticesUVArray =
  [ GL.Vertex2 0 0
  , GL.Vertex2 1 0
  , GL.Vertex2 0 1
  , GL.Vertex2 1 1
  ]

-- | generates repeating RGB points
generateRGBA :: Int -> [GL.Color4 GL.GLfloat]
generateRGBA i =
  take i
    $ cycle
        [ GL.Color4 1.0 0.0 0.0 1.0
        , GL.Color4 0.0 1.0 0.0 1.0
        , GL.Color4 0.0 0.0 1.0 1.0
        ]

-- | memory size of an array
sizeOfArray :: (Storable a, Num b) => [a] -> b
sizeOfArray [] = 0
sizeOfArray (x:xs) = fromIntegral $ (*) ( 1 + length xs) $ sizeOf x

-- | creates a buffer from an array
createVBO :: (Storable (a GL.GLfloat), Vertex (a GL.GLfloat)) => [a GL.GLfloat] -> GL.NumComponents -> GL.AttribLocation -> IO GL.BufferObject
createVBO array numComponents attribLocation = do
  buffer <- GL.genObjectName
  GL.bindBuffer GL.ArrayBuffer $= Just buffer
  withArray
    array
    $ \ptr ->
        GL.bufferData GL.ArrayBuffer $= (sizeOfArray array, ptr, GL.StaticDraw)
  GL.vertexAttribPointer attribLocation $=
    ( GL.ToFloat
    , GL.VertexArrayDescriptor
        numComponents
        GL.Float
        0
        (bufferOffset 0)
    )
  GL.vertexAttribArray attribLocation $= GL.Enabled
  return buffer

-- | turn a vector array into a DisplayableObject with a vao and the like
createDisplayableObject :: (Storable (a GL.GLfloat), Vertex (a GL.GLfloat)) => [a GL.GLfloat] -> GL.NumComponents -> GL.PrimitiveMode -> IO DisplayableObject
createDisplayableObject array numComponents primitiveMode = do
  vao <- GL.genObjectName
  GL.bindVertexArrayObject $= Just vao
  vbo_0 <- createVBO array numComponents $ GL.AttribLocation 0
  vbo_1 <- createVBO (generateRGBA $ length array) 4 $ GL.AttribLocation 1 -- RGB
  vbo_2 <- createVBO verticesUVArray 2 $ GL.AttribLocation 2 -- Texture
  return
    (DisplayableObject
      vao
      (fromIntegral $ length array)
      numComponents
      primitiveMode
    )

-- | pull texture from filepath
loadTexture :: FilePath -> IO GL.TextureObject
loadTexture filepath = do
  -- TODO handle Left case
  Right texture <- GLU.readTexture filepath
  GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
  GLU.texture2DWrap $= (GL.Repeated, GL.ClampToEdge)
  return texture

-- | creates objects, shaders, etc. as appropriate
initResources :: GLFW.Window -> IO DisplayableObjects
initResources window = do
  -- create objects
  verticesObject <- createDisplayableObject verticesArray 3 GL.TriangleStrip
  testObject <- createDisplayableObject testArray 3 GL.TriangleStrip
  let objects = [verticesObject, testObject] -- return value

  -- load shader program
  program <- loadShaders
    [ ShaderInfo GL.VertexShader (StringSource $ unpack $ GLSL.generateGLSL vertShader)
    , ShaderInfo GL.FragmentShader (StringSource $ unpack $ GLSL.generateGLSL fragShader)
    ]
  putTextLn "vertex shader:"
  putTextLn $ GLSL.generateGLSL vertShader
  putTextLn "fragment shader:"
  putTextLn $ GLSL.generateGLSL fragShader
  GL.currentProgram $= Just program
  putTextLn "compiled shader program with success"

  -- load texture
  GL.activeTexture $= GL.TextureUnit 0
  let tex = "./assets/flag.png"
  tx <- loadTexture tex
  GL.texture GL.Texture2D $= GL.Enabled
  GL.textureBinding GL.Texture2D $= Just tx
  location1 <- GL.get $ GL.uniformLocation program "tex"
  GL.uniform location1 $= (GL.TextureUnit 0)
  putTextLn "loaded textures successfully"

  -- load projection matrix
  GLFW.swapBuffers window
  GLFW.swapBuffers window
  GLFW.swapBuffers window
  (w, h) <- GLFW.getFramebufferSize window
  putTextLn "got buffer size"
  let
    perspectiveMatrix =
      toGLMatrix
        $ L.perspective
            (78 * 3.141592653 / 180) -- 78 degree FOV
            ((fromIntegral w) / (fromIntegral h)) -- aspect ratio
            0.1 -- near plane
            100 -- far plane
          L.!*!
            L.lookAt
              (L.V3 0 0 (-2)) -- camera position
              (L.V3 0 0 0) -- point to look at
              (L.V3 0 1 0) -- up vector
  putTextLn "created perspective matrix"
  projection <- GL.newMatrix GL.ColumnMajor perspectiveMatrix :: IO (GL.GLmatrix GL.GLfloat)
  location0 <- GL.get $ GL.uniformLocation program "projection"
  GL.uniform location0 $= projection
  putTextLn "passed projection buffer"

  -- return all objects created earlier
  return objects
