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
data Config = Config
{ Config -> Source
configContainer :: Source
, Config -> Source
configTexture :: Source
}
deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show)
collectionTextures :: Foldable collection => collection Font -> Vector (Texture Flat)
collectionTextures :: forall (collection :: * -> *).
Foldable collection =>
collection Font -> Vector (Texture Flat)
collectionTextures = [Texture Flat] -> Vector (Texture Flat)
forall (v :: * -> *) a. Vector v a => [a] -> v a
Vector.fromList ([Texture Flat] -> Vector (Texture Flat))
-> (collection Font -> [Texture Flat])
-> collection Font
-> Vector (Texture Flat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Font -> Texture Flat) -> [Font] -> [Texture Flat]
forall a b. (a -> b) -> [a] -> [b]
map Font -> Texture Flat
texture ([Font] -> [Texture Flat])
-> (collection Font -> [Font]) -> collection Font -> [Texture Flat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. collection Font -> [Font]
forall a. collection a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
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
$sel:configContainer:Config :: Config -> Source
$sel:configTexture:Config :: Config -> Source
configContainer :: Source
configTexture :: Source
..} = do
Container
container <- (HasCallStack => m Container) -> m Container
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m Container) -> m Container)
-> (HasCallStack => m Container) -> m Container
forall a b. (a -> b) -> a -> b
$
Source -> m Container
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Source -> m Container
EvanW.load Source
configContainer
Texture Flat
texture <- (HasCallStack => m (Texture Flat)) -> m (Texture Flat)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => m (Texture Flat)) -> m (Texture Flat))
-> (HasCallStack => m (Texture Flat)) -> m (Texture Flat)
forall a b. (a -> b) -> a -> b
$
Queues CommandPool -> Source -> m (Texture Flat)
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
$sel:texture:Font :: Texture Flat
$sel:container:Font :: Container
container :: Container
texture :: Texture Flat
..}