<commit_before>{-# LANGUAGE OverloadedStrings #-}

-----------------------------------------------------------------------------
-- |
-- Copyright   : (C) 2014 <NAME>
-- License     : BSD3
--
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : portable
--
----------------------------------------------------------------------------

module Quaazar.Technics.Lighting.Phong where

import Control.Applicative hiding ( empty )
import Control.Lens
import Control.Monad.Error.Class ( MonadError )
import Control.Monad.Trans ( MonadIO(..) )
import Data.Aeson
import Data.IORef ( modifyIORef, newIORef, readIORef, writeIORef )
import Data.Map as M ( delete, empty, insert, lookup )
import Numeric.Natural ( Natural )
import Quaazar.Core.Loader ( Load(..) )
import Quaazar.Core.Resource ( Manager(..), Resource(..) )
import Quaazar.Render.GL.Texture as GL ( Filter, Texture2D, Wrap )
import Quaazar.Render.GLSL
import Quaazar.Render.Shader
import Quaazar.Utils.Log
import Quaazar.Utils.Scoped

data PhongMaterial = PhongMaterial {
    diffuseMap  :: Texture2D
  , specularMap :: Texture2D
  , glossMap    :: Texture2D
  }

data PhongMaterialManifest = PhongMaterialManifest String String String

instance FromJSON PhongMaterialManifest where
  parseJSON = withObject "phong material" $ \o ->
    PhongMaterialManifest
      <$> o .: "diffuse"
      <*> o .: "specular"
      <*> o .: "gloss"

instance Load () PhongMaterialManifest where
  loadRoot = const "materials"
  loadExt = const "qmat"

{-
instance Resource (TextureManager,GPUTextureManager,GL.Wrap,GL.Filter) PhongMaterial where
  manager root = do
      ref <- liftIO $ newIORef empty
      return $ Manager (retrieve_ ref) (release_ ref)
    where
      retrieve_ ref (texMgr,gtexMgr,wrap,flt) name = do
        mp <- liftIO $ readIORef ref
        case M.lookup name mp of
          Just mat -> return mat
          Nothing -> do
            mat <- do
              PhongMaterialManifest dp sp gp <- load root name
              PhongMaterial
                <$> retrieve gtexMgr (texMgr,wrap,flt) dp
                <*> retrieve gtexMgr (texMgr,wrap,flt) sp
                <*> retrieve gtexMgr (texMgr,wrap,flt) gp
            liftIO . writeIORef ref $ insert name mat mp
            return mat
      release_ ref name = liftIO . modifyIORef ref $ delete name

type PhongMaterialManager = Manager (TextureManager,GPUTextureManager,GL.Wrap,GL.Filter) PhongMaterial
-}

phong :: (MonadScoped IO m,MonadIO m,MonadLogger m,MonadError Log m)
      => m (GPUProgram PhongMaterial)
phong = gpuProgram phongVS Nothing Nothing phongFS $ \mat -> do
    uniform phongDiffMapSem $= (diffuseMap mat,0 :: Natural)
    uniform phongSpecMapSem $= (specularMap mat,1 :: Natural)
    uniform phongGlossMapSem $= (glossMap mat,2 :: Natural)

phongDiffMapSem :: Natural
phongDiffMapSem = 128

phongSpecMapSem :: Natural
phongSpecMapSem = 129

phongGlossMapSem :: Natural
phongGlossMapSem = 130
<commit_msg>PhongMaterial has its Manager back.<commit_after>{-# LANGUAGE OverloadedStrings #-}

-----------------------------------------------------------------------------
-- |
-- Copyright   : (C) 2014 <NAME>
-- License     : BSD3
--
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : portable
--
----------------------------------------------------------------------------

module Quaazar.Technics.Lighting.Phong where

import Control.Applicative hiding ( empty )
import Control.Lens
import Control.Monad.Error.Class ( MonadError )
import Control.Monad.Trans ( MonadIO(..) )
import Data.Aeson
import Data.IORef ( modifyIORef, newIORef, readIORef, writeIORef )
import Data.Map as M ( delete, empty, insert, lookup )
import Numeric.Natural ( Natural )
import Quaazar.Core.Loader
import Quaazar.Core.Resource ( Manager(..), Resource(..) )
import Quaazar.Render.GL.Texture ( CompareFunc, Filter, Texture2D
                                 , Texture2DManager, Wrap )
import Quaazar.Render.GLSL
import Quaazar.Render.Shader
import Quaazar.Utils.Log
import Quaazar.Utils.Scoped

data PhongMaterial = PhongMaterial {
    diffuseMap  :: Texture2D
  , specularMap :: Texture2D
  , glossMap    :: Texture2D
  }

data PhongMaterialManifest = PhongMaterialManifest String String String

instance FromJSON PhongMaterialManifest where
  parseJSON = withObject "phong material" $ \o ->
    PhongMaterialManifest
      <$> o .: "diffuse"
      <*> o .: "specular"
      <*> o .: "gloss"

instance Load () PhongMaterialManifest where
  loadRoot = const "materials"
  loadExt = const "qmat"

instance Resource (Texture2DManager,Wrap,Filter,Maybe CompareFunc,Natural,Natural) PhongMaterial where
  manager root = do
      ref <- liftIO $ newIORef empty
      return $ Manager (retrieve_ ref) (release_ ref)
    where
      retrieve_ ref (texMgr,wrap,flt,cmpf,baseLvl,maxLvl) name = do
        mp <- liftIO $ readIORef ref
        case M.lookup name mp of
          Just mat -> return mat
          Nothing -> do
            mat <- do
              PhongMaterialManifest dp sp gp <- load_ root name
              PhongMaterial
                <$> retrieve texMgr (wrap,flt,cmpf,baseLvl,maxLvl) dp
                <*> retrieve texMgr (wrap,flt,cmpf,baseLvl,maxLvl) sp
                <*> retrieve texMgr (wrap,flt,cmpf,baseLvl,maxLvl) gp
            liftIO . writeIORef ref $ insert name mat mp
            return mat
      release_ ref name = liftIO . modifyIORef ref $ delete name

type PhongMaterialManager = Manager (Texture2DManager,Wrap,Filter,Maybe CompareFunc,Natural,Natural) PhongMaterial

phong :: (MonadScoped IO m,MonadIO m,MonadLogger m,MonadError Log m)
      => m (GPUProgram PhongMaterial)
phong = gpuProgram phongVS Nothing Nothing phongFS $ \mat -> do
    uniform phongDiffMapSem $= (diffuseMap mat,0 :: Natural)
    uniform phongSpecMapSem $= (specularMap mat,1 :: Natural)
    uniform phongGlossMapSem $= (glossMap mat,2 :: Natural)

phongDiffMapSem :: Natural
phongDiffMapSem = 128

phongSpecMapSem :: Natural
phongSpecMapSem = 129

phongGlossMapSem :: Natural
phongGlossMapSem = 130

{'fraction_non_alphanumeric': 0.14229314031913143, 'fraction_numerical': 0.007402533311399902, 'mean_word_length': 2.6125965537730242, 'pattern_counts': {'":': 0, '<': 31, '<?xml version=': 0, '>': 33, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 1, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1870818', 'n_tokens_mistral': 1896, 'n_tokens_neox': 1836, 'n_words': 489}