definitive-graphics-1.0: Data/Font.hs

{-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-}
module Data.Font (
  Font,
  font,glyph
  ) where

import Algebra
import Data.Raster
import Graphics.Rendering.TrueType.STB hiding (Font,findGlyph)
import qualified Graphics.Rendering.TrueType.STB as TT
import Control.Exception (SomeException)
import Data.Vector.Storable (unsafeFromForeignPtr0)
import Codec.Picture

newtype Font = Font [TT.Font]
             deriving (Semigroup,Monoid)
                   
font :: Chunk -> Either SomeException Font
font s = by thunk $ catch (return . Left) $ Right . Font <$> do
  let tt = TrueType s
  enumerateFonts tt >>= traverse (initFont tt)

glyph :: Font -> (Char,Float) -> Maybe Raster
glyph (Font fs) = \(c,sc) -> foldMap (charBM c sc) fs
  where charBM c sc f = fg f c <&> \g -> bm  f g (scl sc,scl sc) & bitmap2Image
          where scl = scaleForPixelHeight (getFontVerticalMetrics f^.thunk)
        fg = map2 (by thunk) TT.findGlyph
        bm = map3 (fst.by thunk) TT.newGlyphBitmap
bitmap2Image :: Bitmap -> Raster
bitmap2Image (Bitmap (w,h) p) = ImageY8 (Image w h (unsafeFromForeignPtr0 p (w*h)))^.raster