module Resource.Font
  ( Config(..)
  , collectionTextures

  , Font(..)
  , allocate
  ) where

import RIO

import GHC.Stack (withFrozenCallStack)
import RIO.Vector qualified as Vector
import UnliftIO.Resource qualified as Resource
import Vulkan.Core10 qualified as Vk

import Engine.Vulkan.Types (MonadVulkan, Queues)
import Resource.Font.EvanW qualified as EvanW
import Resource.Source (Source)
import Resource.Texture (Texture, Flat)
import Resource.Texture.Ktx2 qualified as Ktx2

-- * General collection tools

data Config = Config
  { Config -> Source
configContainer :: Source
  , Config -> Source
configTexture   :: Source
  }
  deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

collectionTextures :: Foldable collection => collection Font -> Vector (Texture Flat)
collectionTextures :: forall (collection :: * -> *).
Foldable collection =>
collection Font -> Vector (Texture Flat)
collectionTextures = forall (v :: * -> *) a. Vector v a => [a] -> v a
Vector.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Font -> Texture Flat
texture forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- * Individual fonts

data Font = Font
  { Font -> Container
container :: EvanW.Container
  , Font -> Texture Flat
texture   :: Texture Flat
  }

allocate
  :: ( HasCallStack
     , MonadVulkan env m
     , HasLogFunc env
     , MonadThrow m
     , Resource.MonadResource m
     )
  => Queues Vk.CommandPool
  -> Config
  -> m Font
allocate :: forall env (m :: * -> *).
(HasCallStack, MonadVulkan env m, HasLogFunc env, MonadThrow m,
 MonadResource m) =>
Queues CommandPool -> Config -> m Font
allocate Queues CommandPool
pools Config{Source
configTexture :: Source
configContainer :: Source
$sel:configTexture:Config :: Config -> Source
$sel:configContainer:Config :: Config -> Source
..} = do
  Container
container <- forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Source -> m Container
EvanW.load Source
configContainer

  Texture Flat
texture <- forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$
    forall a env (m :: * -> *).
(TextureLayers a, MonadVulkan env m, MonadResource m, MonadThrow m,
 HasLogFunc env, Typeable a, HasCallStack) =>
Queues CommandPool -> Source -> m (Texture a)
Ktx2.load Queues CommandPool
pools Source
configTexture

  pure Font{Texture Flat
Container
texture :: Texture Flat
container :: Container
$sel:container:Font :: Container
$sel:texture:Font :: Texture Flat
..}