Font.hs

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

module Aztecs.GL.Text.Font
  ( -- * Fonts
    Font (..),
  )
where

import Aztecs
import Aztecs.GL.Internal
import Aztecs.GL.Text.Label.Internal
import Control.Monad
import Control.Monad.IO.Class
import Data.IORef
import qualified Data.Map.Strict as Map
import Debug.Trace
import FreeType.Core.Base
import Prelude hiding (lookup)

-- | Font component - loads and holds a FreeType font face
newtype Font = Font
  { -- | Path to the font file
    fontFilePath :: FilePath
  }
  deriving (Show, Eq)

instance (MonadIO m) => Component m Font where
  componentOnInsert e font = do
    liftIO $ traceIO $ "[Font] componentOnInsert called for entity " ++ show e
    inAnyWindowContext $ do
      liftIO $ traceIO $ "[Font] Inside inAnyWindowContext for entity " ++ show e
      (_, fc) <- fontCache
      -- Load the FreeType face (size will be set per-label)
      face <- liftIO $ loadFontFace fc (fontFilePath font)
      liftIO $ traceIO $ "[Font] FontState created for entity " ++ show e
      insert e $ bundle FontState {fontStateFace = face}

loadFontFace :: FontCache -> FilePath -> IO FT_Face
loadFontFace fc path = do
  faces <- readIORef (fontCacheFaces fc)
  case Map.lookup path faces of
    Just face -> return face
    Nothing -> do
      face <- ft_New_Face (fontCacheLibrary fc) path 0
      modifyIORef (fontCacheFaces fc) $ Map.insert path face
      return face