2 files changed, 91 insertions(+), 33 deletions(-)

M src/Typograffiti/Atlas.hs
M src/Typograffiti/Store.hs

@@ 15,6 15,7 @@ module Typograffiti.Atlas where
 import           Control.Monad
 import           Control.Monad.Except                              (MonadError (..))
 import           Control.Monad.IO.Class
+import           Data.Maybe                                        (fromMaybe)
 import           Data.IntMap                                       (IntMap)
 import qualified Data.IntMap                                       as IM
 import           Data.Vector.Unboxed                               (Vector)


@@ 179,45 180,64 @@ allocAtlas
 allocAtlas fontFilePath gs str = do
   e <- liftIO $ runFreeType $ do
     fce <- newFace fontFilePath
-    case gs of
-      GlyphSizeInPixels w h -> setPixelSizes fce w h
-      GlyphSizeByChar (CharSize w h dpix dpiy) -> setCharSize fce w h dpix dpiy
-
-    (amMap, am) <- foldM (measure fce 512 renderGlyph) (mempty, emptyAM) str
-
-    let V2 w h = amWH am
-        xymap :: IntMap (V2 Int)
-        xymap  = amXY <$> amMap
-
-    t <- liftIO $ do
-      t <- allocAndActivateTex GL_TEXTURE0
-      glPixelStorei GL_UNPACK_ALIGNMENT 1
-      withCString (replicate (w * h) $ toEnum 0) $
-        glTexImage2D GL_TEXTURE_2D 0 GL_RED (fromIntegral w) (fromIntegral h)
-                     0 GL_RED GL_UNSIGNED_BYTE . castPtr
-      return t
-
-    lib   <- getLibrary
-    atlas <- foldM (texturize xymap) (emptyAtlas lib fce t) str
-
-    glGenerateMipmap GL_TEXTURE_2D
-    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT
-    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT
-    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR
-    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR
-    glBindTexture GL_TEXTURE_2D 0
-    glPixelStorei GL_UNPACK_ALIGNMENT 4
-    return
-      atlas{ atlasTextureSize = V2 w h
-           , atlasGlyphSize = gs
-           , atlasFilePath = fontFilePath
-           }
+    allocRichAtlas fontFilePath fce (Just gs) renderGlyph str
 
   either
     (throwError . TypograffitiErrorFreetype "cannot alloc atlas")
     (return . fst)
     e
 
+-- | Allocate a new 'Atlas'.
+-- When creating a new 'Atlas' you must pass all the characters that you
+-- might need during the life of the 'Atlas'. Character texturization only
+-- happens once.
+allocRichAtlas
+  :: String
+  -- ^ Key identifying this altered font.
+  -> FT_Face
+  -- ^ Raw FreeType2-loaded font.
+  -> Maybe GlyphSize
+  -- ^ Size of glyphs in this Atlas, callers may configure this externally.
+  -> (FT_GlyphSlot -> FreeTypeIO ())
+  -- ^ Callback for mutating each glyph loaded from the given font.
+  -> String
+  -- ^ The characters to include in this 'Atlas'.
+  -> FreeTypeIO Atlas
+allocRichAtlas key fce gs cb str = do
+  case gs of
+    Just (GlyphSizeInPixels w h) -> setPixelSizes fce w h
+    Just (GlyphSizeByChar (CharSize w h dpix dpiy)) -> setCharSize fce w h dpix dpiy
+    Nothing -> return ()
+
+  (amMap, am) <- foldM (measure fce 512 cb) (mempty, emptyAM) str
+
+  let V2 w h = amWH am
+      xymap :: IntMap (V2 Int)
+      xymap  = amXY <$> amMap
+
+  t <- liftIO $ do
+    t <- allocAndActivateTex GL_TEXTURE0
+    glPixelStorei GL_UNPACK_ALIGNMENT 1
+    withCString (replicate (w * h) $ toEnum 0) $
+      glTexImage2D GL_TEXTURE_2D 0 GL_RED (fromIntegral w) (fromIntegral h)
+                   0 GL_RED GL_UNSIGNED_BYTE . castPtr
+    return t
+
+  lib   <- getLibrary
+  atlas <- foldM (texturize xymap) (emptyAtlas lib fce t) str
+
+  glGenerateMipmap GL_TEXTURE_2D
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR
+  glBindTexture GL_TEXTURE_2D 0
+  glPixelStorei GL_UNPACK_ALIGNMENT 4
+  return
+    atlas{ atlasTextureSize = V2 w h
+         , atlasGlyphSize = fromMaybe (GlyphSizeInPixels 0 0) gs
+         , atlasFilePath = key
+         }
 
 -- | Releases all resources associated with the given 'Atlas'.
 freeAtlas :: MonadIO m => Atlas -> m ()

@@ 28,6 28,7 @@ import           Linear
 import           Typograffiti.Atlas
 import           Typograffiti.Cache
 import           Typograffiti.Glyph
+import           Typograffiti.Utils     (FT_Face, FT_GlyphSlot, FreeTypeIO(..))
 
 
 -- | A pre-rendered bit of text, ready to display given


@@ 71,6 72,8 @@ getTextRendering
   -> FilePath
   -- ^ The path to the font to use
   -- for rendering.
+  -- Or alternatively: the `key`
+  -- identifying a registered font.
   -> GlyphSize
   -- ^ The size of the font glyphs.
   -> String


@@ 149,3 152,38 @@ allocFont store file sz = do
     $ putTMVar mvar
     $ s{ textRenderingDataFontMap = M.insert (file, sz) font fontmap }
   return font
+
+registerFont
+  :: Layout t
+  => FontStore t
+  -> String
+  -> FT_Face
+  -> Maybe GlyphSize
+  -> (FT_GlyphSlot -> FreeTypeIO ())
+  -> FreeTypeIO (Font t)
+-- | Register an externally-loaded font under a given key (low-level API)
+-- Allows registering a callback for mutating glyphs prior
+-- to being composited into place on the GPU, which is
+-- responsible for ensuring Typograffiti has a bitmap to composite.
+registerFont store key fce sz cb = do
+  let mvar = unFontStore store
+  s     <- liftIO $ atomically $ takeTMVar mvar
+  atlas <-
+    allocRichAtlas
+      key
+      fce
+      sz
+      cb
+      $ S.toList
+      $ textRenderingDataCharSet s
+  let fontmap = textRenderingDataFontMap s
+      font = Font
+        { fontAtlas     = atlas
+        , fontWordCache = mempty
+        }
+  let sz' = atlasGlyphSize atlas
+  liftIO
+    $ atomically
+    $ putTMVar mvar
+    $ s{ textRenderingDataFontMap = M.insert (key, sz') font fontmap }
+  return font