Material.hs

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

module Aztecs.GL.Material
  ( -- * Materials
    OfMaterial (..),
    Material (..),
    color,
  )
where

import Aztecs
import Aztecs.GL.Internal
import Control.Monad.IO.Class
import Graphics.Rendering.OpenGL (($=))
import qualified Graphics.Rendering.OpenGL as GL
import Prelude hiding (lookup)

-- | Material component
newtype Material = Material {unMaterial :: IO MaterialState}

instance (MonadIO m) => Component m Material where
  componentOnInsert e mat = do
    matState <- liftIO $ unMaterial mat
    insert e $ bundle matState
    mOfMesh <- lookup e
    case mOfMesh of
      Just (OfMesh meshE) -> registerRenderable e meshE e
      Nothing -> do
        mMeshState <- lookup @_ @MeshState e
        case mMeshState of
          Just _ -> registerRenderable e e e
          Nothing -> return ()
  componentOnChange e _ new = do
    matState <- liftIO $ unMaterial new
    insert e $ bundle matState
  componentOnRemove e _ = do
    mOfMesh <- lookup e
    case mOfMesh of
      Just (OfMesh meshE) -> unregisterRenderable e meshE e
      Nothing -> do
        mMeshState <- lookup @_ @MeshState e
        case mMeshState of
          Just _ -> unregisterRenderable e e e
          Nothing -> return ()

-- | Create a solid color material renderer from RGBA values
color :: Float -> Float -> Float -> Float -> Material
color r g b a =
  Material . return $
    MaterialState
      { materialPush = do
          GL.texture GL.Texture2D $= GL.Disabled
          GL.color $ GL.Color4 (realToFrac r) (realToFrac g) (realToFrac b) (realToFrac a :: GL.GLfloat),
        materialPop = return ()
      }