pituicat/src/Scenes/Test.hs

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

import Affection

import SDL (($=), get)
import qualified SDL

import qualified Graphics.Rendering.OpenGL as GL

import qualified Data.Vector.Storable as VS

import Control.Concurrent.STM

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
  }

data GLAssets = GLAssets
  { glVA :: VertexArray
  , glVB :: VertexBuffer
  , glIB :: IndexBuffer
  , glSP :: Shader
  }

instance Scene Test where

  initScene =
    Test
      <$> newEmptyTMVarIO
      <*> newEmptyTMVarIO
      <*> newTVarIO False

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

    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)

    unbind vertexArray
    unbind vertexBuffer
    unbind indexBuffer
    unbind shader

    atomically $ do
      putTMVar (testGraphics level)
        (GLAssets vertexArray vertexBuffer indexBuffer shader)
      writeTVar (testLoaded level) True

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


  isSceneLoaded = liftIO . atomically . readTVar . testLoaded

  update _ _ = return ()

  onEvents _ _ = return ()

  render level = liftIO $ do
    (GLAssets va vb ib sh) <- atomically (readTMVar $ testGraphics level)
    bind vb
    R.draw va ib sh

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 pos@(V2 x y) index =
  [ newVertex (V3 x y 0)               (V4 0 1 0 1) (V2 0 1) (fromIntegral index)
  , newVertex (V3 (x + 32) y 0)        (V4 0 1 0 1) (V2 0 1) (fromIntegral index)
  , newVertex (V3 (x + 32) (y + 32) 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index)
  , newVertex (V3 x (y + 32) 0)        (V4 0 1 0 1) (V2 0 1) (fromIntegral index)
  ]