Internal.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Aztecs.GL.Text.Font.Internal
  ( -- * Label State
    LabelState (..),
    GlyphInfo (..),

    -- * Font State
    FontState (..),

    -- * Font Cache
    FontCache (..),
    fontCache,
  )
where

import Aztecs
import Control.Monad.IO.Class
import Data.IORef
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Vector as V
import FreeType.Core.Base
import qualified Graphics.Rendering.OpenGL as GL
import Prelude hiding (lookup)

-- | Information about a rendered glyph
data GlyphInfo = GlyphInfo
  { glyphTexture :: !GL.TextureObject,
    glyphWidth :: !Int,
    glyphHeight :: !Int,
    glyphBearingX :: !Int,
    glyphBearingY :: !Int,
    glyphAdvance :: !Int
  }
  deriving (Show, Eq)

-- | Label state component
data LabelState = LabelState
  { labelGlyphs :: ![GlyphInfo],
    labelTotalWidth :: !Float,
    labelTotalHeight :: !Float
  }

instance (Monad m) => Component m LabelState

-- | Font state component
newtype FontState = FontState {fontStateFace :: FT_Face}

instance (Monad m) => Component m FontState

-- | Font cache singleton that holds FreeType resources
data FontCache = FontCache
  { fontCacheLibrary :: !FT_Library,
    fontCacheFaces :: !(IORef (Map FilePath FT_Face)),
    fontCacheGlyphs :: !(IORef (Map FilePath (Map Char GlyphInfo)))
  }

instance (Monad m) => Component m FontCache

-- | Get or create the @FontCache@ singleton
fontCache :: (MonadIO m) => Access m (EntityID, FontCache)
fontCache = do
  res <- system . readQuery $ (,) <$> entity <*> query @_ @FontCache
  case V.uncons res of
    Just ((e, fc), _) -> return (e, fc)
    Nothing -> do
      fc <- liftIO initFontCache
      e <- spawn $ bundle fc
      return (e, fc)

-- | Initialize the FreeType library and create a new font cache
initFontCache :: IO FontCache
initFontCache = do
  lib <- ft_Init_FreeType
  facesRef <- newIORef Map.empty
  glyphsRef <- newIORef Map.empty
  return $ FontCache lib facesRef glyphsRef