Textures.hs

module Resource.Combined.Textures
  ( Collection(..)
  , attachDebugNames
  ) where

import RIO

import GHC.Stack (withFrozenCallStack)

import Engine.Vulkan.Types (MonadVulkan)
import Resource.Texture (Texture, debugNameCollection)

data Collection textures fonts a = Collection
  -- XXX: textures go first, as there should be a filler texture at [0]
  { textures :: textures a
  , fonts    :: fonts a
  }
  deriving (Show, Functor, Foldable, Traversable, Generic)

instance
  ( Applicative t
  , Applicative f
  )
  => Applicative (Collection t f) where
  pure x = Collection
    { textures = pure x
    , fonts    = pure x
    }

  af <*> ax = Collection
    { textures = textures af <*> textures ax
    , fonts    = fonts af <*> fonts ax
    }

attachDebugNames
  :: ( Traversable textures
     , Traversable fonts
     , MonadVulkan env m
     , HasLogFunc env
     , HasCallStack
     )
  => Collection textures fonts (Texture a)
  -> textures FilePath
  -> fonts FilePath
  -> m ()
attachDebugNames combined texturePaths fontPaths =
  withFrozenCallStack $
    debugNameCollection combined Collection
      { textures = texturePaths
      , fonts    = fontPaths
      }