module Vivant.Terrain (Terrain (..), initTerrain) where

import qualified Data.Vector.Storable as V
import Foreign.Marshal.Alloc (free, malloc)
import Foreign.Ptr
import Foreign.Storable (poke)
import qualified Graphics.Rendering.OpenGL as GL
import Linear
import SDL (($=))
import Vivant.Common (uncurry3, vectorSize)
import Vivant.Renderer

data Terrain = Terrain
  { terrainWidth :: Int,
    terrainHeight :: Int,
    terrainGeometry :: [[Float]],
    terrainRenderer :: Renderer
  }
  deriving (Show)

normal :: Num c => (c, c, c) -> (c, c, c) -> (c, c, c) -> (c, c, c)
normal a b c =
  transform $ cross (uncurry3 V3 b ^-^ uncurry3 V3 a) (uncurry3 V3 c ^-^ uncurry3 V3 a)
  where
    transform (V3 a b c) = (a, b, c)

partition ::
  (V.Storable a1, Enum a1, Num a1) => [[a1]] -> V.Vector a1
partition r =
  V.fromList . concat . concat
    . fmap (\(e, y) -> fmap (generateP y) $ zip (zip (uncurry zip e) $ tail (uncurry zip e)) [0 ..])
    $ zip (zip r $ tail r) [0 ..]
  where
    generateP y (((z1, z2), (z3, z4)), x) =
      let (n1x, n1y, n1z) = normal (x, y, z1) (x, y + 1, z2) (x + 1, y, z3)
          (n2x, n2y, n2z) = normal (x + 1, y + 1, z4) (x, y + 1, z2) (x + 1, y, z3)
       in [ x,
            y,
            z1,
            - n1x,
            - n1y,
            - n1z,
            x,
            y + 1,
            z2,
            - n1x,
            - n1y,
            - n1z,
            x + 1,
            y,
            z3,
            - n1x,
            - n1y,
            - n1z,
            x,
            y + 1,
            z2,
            n2x,
            n2y,
            n2z,
            x + 1,
            y,
            z3,
            n2x,
            n2y,
            n2z,
            x + 1,
            y + 1,
            z4,
            n2x,
            n2y,
            n2z
          ]

initTerrain :: [[Float]] -> GL.Program -> IO Terrain
initTerrain g p = do
  vao <- GL.genObjectName
  GL.bindVertexArrayObject $= Just vao

  vbo <- GL.genObjectName
  GL.bindBuffer GL.ArrayBuffer $= Just vbo

  let g' = partition g :: V.Vector Float
  V.unsafeWith g' $ \ptr ->
    GL.bufferData GL.ArrayBuffer $= (vectorSize g', castPtr ptr, GL.StaticDraw)

  setVertexAttribute p "position" 3 6 0
  setVertexAttribute p "normal" 3 6 3

  GL.bindVertexArrayObject $= Nothing

  let h = length g
      w = length (head g)
      modelMatrix =
        mkTransformation
          (axisAngle (V3 0 0 0) 0)
          (V3 (- fromIntegral w / 2) (- fromIntegral h / 2) 0)

  modelP <- malloc
  poke modelP modelMatrix

  return $ Terrain w h g (Renderer (Just p) (Just vao) modelP ((w + 2) * (h + 2) * 8))

destroyTerrain :: Terrain -> IO ()
destroyTerrain t =
  destroyRenderer $ terrainRenderer t