{-# LANGUAGE OverloadedStrings #-}
module Scenes.Test where

import Affection

import qualified Graphics.Rendering.OpenGL as GL

import qualified Data.Vector.Storable as VS
import qualified Data.Vector as V

import Data.String

import Control.Concurrent.STM

import Control.Arrow ((***))

import Control.Monad (void)

import Linear

-- internal imports

import Types
import Classes
import Map
import Renderer as R

data Test = Test
  { testMap :: TMVar LevelMap
  , testGraphics :: TMVar GLAssets
  , testLoaded :: TVar Bool
  , testStageSet :: TVar (V.Vector StageSet)
  , testCast :: TVar (V.Vector Cast)
  }

data GLAssets = GLAssets
  { glVA :: VertexArray
  , glVB :: VertexBuffer
  , glIB :: IndexBuffer
  , glSP :: Shader
  , glTx :: [Texture]
  }

instance Scene Test where

  initScene =
    Test
      <$> newEmptyTMVarIO
      <*> newEmptyTMVarIO
      <*> newTVarIO False
      <*> newTVarIO V.empty
      <*> newTVarIO V.empty

  loadScene level progress = do
    atomically $ do
      void $ takeTMVar progress
      putTMVar progress (0, "Loading test level...")
    loadedMap <- constructMap testLevelDesc 0
    atomically $ putTMVar (testMap level) loadedMap
    void $ atomically $ do
      void $ takeTMVar progress
      putTMVar progress (0.5, "Loaded test level map!")
    void $ atomically $ swapTVar (testLoaded level) True

    let projection = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
        view = mkTransformationMat
          (identity :: M33 GL.GLfloat)
          (V3 0 ((-64) * 32 + 600) 0)
        model = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)

    vertexArray <- newVertexArray

    bind vertexArray

    vertexBuffer <- newVertexBuffer 1024

    bind vertexBuffer

    let vertices = VS.fromList (createQuad (V2 (400 - 16) (300 - 16)) 0)

    write vertexBuffer 0 vertices

    indexBuffer <- newIndexBuffer 1024

    bind indexBuffer

    let indices = VS.fromList [0, 1, 2, 2, 3, 0]

    write indexBuffer 0 indices

    addBuffer (undefined :: Vertex) vertexBuffer

    (_, tex) <- newTexture "res/pituicat/pituicat.png" 1
    bind tex

    shader <- newShader
      [ ShaderSource GL.VertexShader "./res/shaders/vert.shader"
      , ShaderSource GL.FragmentShader "./res/shaders/frag.shader"
      ]

    bind shader
    setUniform shader "u_mvp" (projection !*! view !*! model)
    setUniformList
      shader
      "u_textures"
      (map
        textureSlot
        [ (tileMapTexture $ mapTileMap loadedMap)
        , tex
        ]
        )

    let pituicat = Pituicat
          (V2 400 1748)
          (V2 0 0)
          (V2 0 0)
          100
          tex

    unbind vertexArray
    unbind vertexBuffer
    unbind indexBuffer
    unbind tex
    unbind shader

    atomically $ do
      putTMVar (testGraphics level)
        (GLAssets vertexArray vertexBuffer indexBuffer shader [tex])
      modifyTVar (testStageSet level) (\set -> StageSet pituicat `V.cons` set)
      writeTVar (testLoaded level) True

    void $ atomically $ do
      void $ takeTMVar progress
      putTMVar progress (1, "Loaded graphics!")


  isSceneLoaded = liftIO . readTVarIO . testLoaded

  update level dt = liftIO $ do
    logIO Debug ("FPS: " <> fromString (show $ 1 / dt))

    -- Let all Actors update themselves (Typeclasses rock!)
    atomically $
      modifyTVar
        (testCast level)
        (V.map (\(Cast c) -> Cast (perform dt c)))

  onEvents _ _ = return ()

  render level = liftIO $ do
    (GLAssets va vb ib sh tx) <- atomically (readTMVar $ testGraphics level)
    (LevelMap layers _ _ tileMap _) <-
      atomically (readTMVar $ testMap level)

    logIO Debug "loaded level"

    stageSet <- readTVarIO (testStageSet level)
    cast <- readTVarIO (testCast level)

    logIO Debug "Read stage set and cast"

    let (indices, vertices) = populate layers stageSet cast

    logIO Debug "Populated"

    bind va
    bind vb
    bind ib

    logIO Debug "Bound buffers"

    write vb 0 vertices

    logIO Debug ("Written " <> fromString (show $ VS.length vertices) <> " vertices")

    write ib 0 (VS.map fromIntegral indices)

    logIO Debug ("Written " <> fromString (show $ VS.length indices) <> " indices")

    logIO Debug "Wrote buffers"

    bind (tileMapTexture tileMap)
    V.mapM_ (\(StageSet p) -> bindPropTexture p) stageSet
    V.mapM_ (\(Cast c) -> bindPropTexture c) cast
    R.draw va ib sh

    logIO Debug "Drawn"

testLevelDesc :: LevelDescriptor
testLevelDesc = LevelDescriptor
  [ (0, "res/maps/00_test/00_test.bmp")
  ]
  0
  "res/tiles/00_test/00_test.png"
  (3, 3)

createQuad :: V2 GL.GLfloat -> Int -> [Vertex]
createQuad (V2 x y) index =
  [ newVertex
    (V3 x y 0)
    (V4 0 0 0 1)
    (V2 0 (1 - (50 / 1024)))
    (fromIntegral index)
  , newVertex
    (V3 (x + 32) y 0)
    (V4 0 0 0 1)
    (V2 (50 / 1024) (1 - (50/1024)))
    (fromIntegral index)
  , newVertex
    (V3 (x + 32) (y + 32) 0)
    (V4 0 0 0 1)
    (V2 (50 / 1024) 1)
    (fromIntegral index)
  , newVertex
    (V3 x (y + 32) 0)
    (V4 0 0 0 1)
    (V2 0 1)
    (fromIntegral index)
  ]

populate
  :: V.Vector Layer
  -> V.Vector StageSet
  -> V.Vector Cast
  -> (VS.Vector Word, VS.Vector Vertex)
populate layers props actors =
  (VS.convert *** VS.convert) $ foldl
    (\(is, vs) (num, l) ->
      let propsHere = V.filter (\(StageSet s) -> residentLayer s == num) props
          actorsHere = V.filter (\(Cast c) -> residentLayer c == num) actors
          (pisRaw, pvs) = V.foldl
            (\(ais, avs) (StageSet s) ->
              let (nis, nvs) = toVertices s
              in
                ( ais V.++ nis
                , avs V.++ nvs)
              )
            (V.empty, V.empty)
            propsHere
          (cisRaw, cvs) = V.foldl
            (\(ais, avs) (Cast c) ->
              let (nis, nvs) = toVertices c
              in
                ( ais V.++ nis
                , avs V.++ nvs)
              )
            (V.empty, V.empty)
            actorsHere
          (lisRaw, lvs) = toVertices l
          lis = V.map
            (+ if null is then 0 else V.maximum is + 1)
            lisRaw
          pis = V.map
            (+
              if null (is V.++ lis)
              then 0
              else V.maximum (is V.++ lis) + 1)
            pisRaw
          cis = V.map
            (+
              if null (is V.++ lis V.++ pis)
              then 0
              else V.maximum (is V.++ lis V.++ pis) + 1)
            cisRaw
      in
        ( is V.++ lis V.++ pis V.++ cis
        , vs V.++ lvs V.++ pvs V.++ cvs
        )
      )
    (V.empty, V.empty)
    (V.zip (V.fromList [0 ..]) layers)
