module Render.Lit.Material.Collect
  ( LoadedModel
  , SceneModel(..)
  , sceneMaterials
  , modelMaterials
  , nodeMaterials
  ) where

import RIO

import RIO.Map qualified as Map
import RIO.Vector.Storable qualified as Storable

import Render.Lit.Material (shiftTextures)
import Render.Lit.Material.Model qualified as LitMaterial
import Resource.Buffer qualified as Buffer
import Resource.Mesh.Types qualified as Mesh
import Resource.Mesh.Lit qualified as Lit
import Render.Lit.Material (Material)

type LoadedModel =
  ( Mesh.Meta
  , Storable.Vector Lit.MaterialNode
  , LitMaterial.Model 'Buffer.Staged
  )

data SceneModel models textures = SceneModel
  { SceneModel models textures -> Text
smLabel            :: Text
  , SceneModel models textures -> models -> LoadedModel
smGetModel         :: models -> LoadedModel
  , SceneModel models textures -> textures -> Int32
smGetTextureOffset :: textures -> Int32
  }

sceneMaterials
  :: Foldable t
  => models
  -> textures
  -> t (SceneModel models textures)
  -> Storable.Vector Material
sceneMaterials :: models
-> textures -> t (SceneModel models textures) -> Vector Material
sceneMaterials models
loadedModels textures
combinedTextures =
  [Material] -> Vector Material
forall a. Storable a => [a] -> Vector a
Storable.fromList ([Material] -> Vector Material)
-> (t (SceneModel models textures) -> [Material])
-> t (SceneModel models textures)
-> Vector Material
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int Material -> [Material]
forall k a. Map k a -> [a]
Map.elems (Map Int Material -> [Material])
-> (t (SceneModel models textures) -> Map Int Material)
-> t (SceneModel models textures)
-> [Material]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Int Material
 -> SceneModel models textures -> Map Int Material)
-> Map Int Material
-> t (SceneModel models textures)
-> Map Int Material
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Int Material -> SceneModel models textures -> Map Int Material
beep Map Int Material
forall a. Monoid a => a
mempty
  where
    beep :: Map Int Material -> SceneModel models textures -> Map Int Material
beep Map Int Material
acc SceneModel{Text
models -> LoadedModel
textures -> Int32
smGetTextureOffset :: textures -> Int32
smGetModel :: models -> LoadedModel
smLabel :: Text
$sel:smGetTextureOffset:SceneModel :: forall models textures.
SceneModel models textures -> textures -> Int32
$sel:smGetModel:SceneModel :: forall models textures.
SceneModel models textures -> models -> LoadedModel
$sel:smLabel:SceneModel :: forall models textures. SceneModel models textures -> Text
..} =
      let
        (Meta
_meta, Vector MaterialNode
materialNodes, Model 'Staged
_model) = models -> LoadedModel
smGetModel models
loadedModels
        textureOffset :: Int32
textureOffset = textures -> Int32
smGetTextureOffset textures
combinedTextures
      in
        Text
-> Int32 -> Map Int Material -> [MaterialNode] -> Map Int Material
forall (t :: * -> *).
Foldable t =>
Text
-> Int32 -> Map Int Material -> t MaterialNode -> Map Int Material
modelMaterials Text
smLabel Int32
textureOffset Map Int Material
acc (Vector MaterialNode -> [MaterialNode]
forall a. Storable a => Vector a -> [a]
Storable.toList Vector MaterialNode
materialNodes)

modelMaterials
  :: Foldable t
  => Text
  -> Int32
  -> Map Int Material
  -> t Lit.MaterialNode
  -> Map Int Material
modelMaterials :: Text
-> Int32 -> Map Int Material -> t MaterialNode -> Map Int Material
modelMaterials Text
label Int32
textureOffset =
  (MaterialNode -> Map Int Material -> Map Int Material)
-> Map Int Material -> t MaterialNode -> Map Int Material
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text
-> Int32 -> MaterialNode -> Map Int Material -> Map Int Material
nodeMaterials Text
label Int32
textureOffset)

nodeMaterials
  :: Text
  -> Int32
  -> Lit.MaterialNode
  -> Map Int Material
  -> Map Int Material
nodeMaterials :: Text
-> Int32 -> MaterialNode -> Map Int Material -> Map Int Material
nodeMaterials Text
label Int32
textureStart Lit.MaterialNode{Int
$sel:mnMaterialIx:MaterialNode :: MaterialNode -> Int
mnMaterialIx :: Int
mnMaterialIx, Material
$sel:mnMaterial:MaterialNode :: MaterialNode -> Material
mnMaterial :: Material
mnMaterial} Map Int Material
collection =
  case Int -> Map Int Material -> Maybe Material
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
mnMaterialIx Map Int Material
collection of
    Maybe Material
Nothing ->
      Int -> Material -> Map Int Material -> Map Int Material
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
mnMaterialIx Material
newMaterial Map Int Material
collection
    Just Material
oldMaterial ->
      if Material
newMaterial Material -> Material -> Bool
forall a. Eq a => a -> a -> Bool
/= Material
oldMaterial then
        [Char] -> Map Int Material
forall a. HasCallStack => [Char] -> a
error ([Char] -> Map Int Material) -> [Char] -> Map Int Material
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
          [ [Char]
"Ouf... The material indices are clashing for " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
label
          , [Char]
"At: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
mnMaterialIx
          , [Char]
"Old: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Material -> [Char]
forall a. Show a => a -> [Char]
show Material
oldMaterial
          , [Char]
"Now: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Material -> [Char]
forall a. Show a => a -> [Char]
show Material
mnMaterial
          ]
      else
        Map Int Material
collection
  where
    newMaterial :: Material
newMaterial =
      Int32 -> Material -> Material
shiftTextures Int32
textureStart Material
mnMaterial