GL.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Aztecs.GL
  ( -- * OpenGL
    module Aztecs.GL.Image,
    module Aztecs.GL.Material,
    module Aztecs.GL.Mesh,
    module Aztecs.GL.Render,
    module Aztecs.GL.Shape,
    module Aztecs.GL.Sprite,
    render,

    -- * Transform
    module Aztecs.Transform,
  )
where

import Aztecs
import Aztecs.GL.Image
import Aztecs.GL.Internal
import Aztecs.GL.Material
import Aztecs.GL.Mesh
import Aztecs.GL.Render
import Aztecs.GL.Shape
import Aztecs.GL.Sprite
import Aztecs.GLFW
import Aztecs.Transform
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.Map.Strict as Map
import Graphics.Rendering.OpenGL (($=))
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.UI.GLFW as GLFW
import Prelude hiding (lookup)

-- | Render all entities with @Mesh@ or @OfMesh@, @Material@ or @OfMaterial@, and @Transform2D@ components
render :: (MonadIO m) => Access m ()
render = do
  windows <- system . readQuery $ (,) <$> query @_ @Window <*> query @_ @RawWindow
  forM_ windows $ \(window, RawWindow raw _) -> do
    liftIO $ do
      GLFW.makeContextCurrent (Just raw)

      -- Set viewport and clear
      GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral $ windowWidth window) (fromIntegral $ windowHeight window))
      GL.clearColor $= GL.Color4 0 0 0 1
      GL.clear [GL.ColorBuffer]

      -- Set up orthographic projection
      GL.matrixMode $= GL.Projection
      GL.loadIdentity
      GL.ortho 0 (fromIntegral $ windowWidth window) 0 (fromIntegral $ windowHeight window) (-1) 1
      GL.matrixMode $= GL.Modelview 0
      GL.loadIdentity

    -- Get render groups and render each group
    (_, RenderGroups groups) <- renderGroups
    forM_ (Map.toList groups) $ \((meshE, matE), entities) -> do
      mMeshState <- do
        mMeshState <- lookup meshE
        case mMeshState of
          Just ms -> return $ Just ms
          Nothing -> do
            mMesh <- lookup meshE
            case mMesh of
              Just mesh -> do
                ms <- liftIO $ unMesh mesh
                insert meshE $ bundle ms
                return $ Just ms
              Nothing -> return Nothing
      mMatState <- do
        mMatState <- lookup matE
        case mMatState of
          Just ms -> return $ Just ms
          Nothing -> do
            mMat <- lookup matE
            case mMat of
              Just mat -> do
                ms <- liftIO $ unMaterial mat
                insert matE $ bundle ms
                return $ Just ms
              Nothing -> return Nothing
      case (mMeshState, mMatState) of
        (Just meshState, Just matState) -> do
          transforms <- forM entities $ \e -> do
            mTrans <- lookup e
            return (e, mTrans)

          liftIO $ do
            materialPush matState
            forM_ transforms $ \(_, mTrans) ->
              case mTrans of
                Just trans -> renderMeshWithTransform meshState trans
                Nothing -> return ()
            materialPop matState
        _ -> return ()

renderMeshWithTransform :: MeshState -> Transform2D -> IO ()
renderMeshWithTransform md t = do
  let V2 tx ty = transformTranslation t
      V2 sx sy = transformScale t
      rot = transformRotation t
  GL.preservingMatrix $ do
    GL.translate $ GL.Vector3 (realToFrac tx) (realToFrac ty) (0 :: GL.GLfloat)
    GL.rotate (realToFrac rot) $ GL.Vector3 0 0 (1 :: GL.GLfloat)
    GL.scale (realToFrac sx) (realToFrac sy) (1 :: GL.GLfloat)
    meshPush md
    meshPop md