From 215106b5078d13513f1297b010ccceae8d88b862 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Thu, 15 Dec 2022 16:36:38 +1300 Subject: [PATCH] Add API for dereferencing & rendering glyphs. --- FreeType/FontConfig.hs | 105 +++++++++++++++++++++++++++++++++++++---- 1 file changed, 96 insertions(+), 9 deletions(-) diff --git a/FreeType/FontConfig.hs b/FreeType/FontConfig.hs index d7b7ea5..3240eef 100644 --- a/FreeType/FontConfig.hs +++ b/FreeType/FontConfig.hs @@ -9,26 +9,29 @@ import FreeType.Core.Base (FT_Face(..)) import Data.Word (Word32, Word) import Foreign.Ptr (nullPtr, Ptr) -import Foreign.Storable (peek) +import Foreign.Storable (Storable(..)) import Foreign.Marshal.Alloc (alloca) import Foreign.C.String (CString, withCString) import System.IO.Unsafe (unsafePerformIO) -import Control.Exception (throw) +import Control.Exception (throw, catch) import Graphics.Text.Font.Choose.Result (Error(ErrTypeMismatch)) -- For FcFt transliteration import Graphics.Text.Font.Choose.Value (Value(..)) import Graphics.Text.Font.Choose.Pattern (getValue', getValue0, getValue, getValues') + import Data.Maybe (fromMaybe) -import FreeType.Core.Base (FT_Library, ft_New_Face, ft_Set_Pixel_Sizes, ft_Set_Transform, - FT_FaceRec(..), FT_SizeRec(..), FT_Size_Metrics(..)) -import FreeType.Control.Subpixel (FT_LcdFilter) -import FreeType.Core.Types (FT_Matrix(..)) import Linear.V2 (V2(..)) import Linear.Matrix(M22) import Data.Bits ((.|.)) +import FreeType.Core.Base +import FreeType.Support.Outline (ft_Outline_Embolden) +import FreeType.Control.Subpixel (FT_LcdFilter, ft_Library_SetLcdFilter) +import FreeType.Core.Types +import FreeType.Exception (FtError(..)) + c2w :: Char -> Word32 c2w = fromIntegral . fromEnum @@ -82,6 +85,7 @@ foreign import ccall "FcFreeTypeQueryFace" fcFreeTypeQueryFace :: ------ --- Transliterated from FcFt --- https://codeberg.org/dnkl/fcft/ +--- Untested ------ data FTFC_Instance = Instance { @@ -107,11 +111,11 @@ data FTFC_Metrics = Metrics { ascent :: Int, maxAdvance :: (Int, Int), metricsAntialias :: Bool, - metricsSubpixel :: Subpixel, + metricsSubpixel :: FTFC_Subpixel, metricsName :: String } -data Subpixel = SubpixelNone | SubpixelHorizontalRGB | SubpixelHorizontalBGR | - SubpixelVerticalRGB | SubpixelVerticalBGR +data FTFC_Subpixel = SubpixelNone | SubpixelHorizontalRGB | SubpixelHorizontalBGR | + SubpixelVerticalRGB | SubpixelVerticalBGR | SubpixelDefault instantiatePattern :: FT_Library -> Pattern -> (Double, Double) -> IO FTFC_Instance instantiatePattern ftlib pattern (req_pt_size, req_px_size) = do @@ -209,6 +213,89 @@ instantiatePattern ftlib pattern (req_pt_size, req_px_size) = do } } +data FTFC_Glyph a = Glyph { + glyphFontName :: String, + glyphImage :: a, + glyphAdvance :: (Double, Double), + glyphSubpixel :: FTFC_Subpixel +} + +glyphForIndex :: FTFC_Instance -> Word32 -> FTFC_Subpixel -> + (FT_Bitmap -> IO a) -> IO (FTFC_Glyph a) +glyphForIndex font index subpixel cb = do + ft_Load_Glyph (fontFace font) index (toEnum $ fontLoadFlags font) + face' <- peek $ fontFace font + size' <- peek $ frSize face' + -- Formula from old FreeType function `FT_GlyphSlotEmbolden`. + -- Approximate as fallback for fonts not using fontsets or variables axis. + let strength = fromIntegral (frUnits_per_EM face')*smY_scale (srMetrics size')`div`24 + glyph' <- peek $ frGlyph face' + + glyph1' <- case gsrFormat glyph' of + FT_GLYPH_FORMAT_OUTLINE | fontEmbolden font -> do + outline <- withPtr (gsrOutline glyph') $ flip ft_Outline_Embolden strength + return glyph' { gsrOutline = outline } + _ -> return glyph' + + let render_flags = case subpixel of { +-- FT_GLYPH_FORMAT_SVG is not exposed by our language bindings, +-- Should be largely irrelevant now... Certain FreeType versions required this flag. +-- _ | FT_GLYPH_FORMAT_SVG <- gsrFormat glyph1' -> ft_RENDER_MODE_NORMAL; + _ | not $ fontAntialias font -> fontRenderFlags font; + SubpixelNone -> fontRenderFlags font; + SubpixelHorizontalRGB -> ft_RENDER_MODE_LCD; + SubpixelHorizontalBGR -> ft_RENDER_MODE_LCD; + SubpixelVerticalRGB -> ft_RENDER_MODE_LCD_V; + SubpixelVerticalBGR -> ft_RENDER_MODE_LCD_V; + SubpixelDefault -> fontRenderFlagsSubpixel font} + let bgr = case subpixel of { + _ | not $ fontAntialias font -> False; + SubpixelNone -> False; + SubpixelHorizontalRGB -> False; + SubpixelHorizontalBGR -> True; + SubpixelVerticalRGB -> False; + SubpixelVerticalBGR -> True; + SubpixelDefault -> fontBGR font} + + can_set_lcd_filter <- isSuccess $ ft_Library_SetLcdFilter (gsrLibrary glyph1') 0 + -- FIXME: Do we need a mutex? + let set_lcd_filter = ft_Library_SetLcdFilter (gsrLibrary glyph1') $ fontLCDFilter font + case render_flags of { + FT_RENDER_MODE_LCD | can_set_lcd_filter -> set_lcd_filter; + FT_RENDER_MODE_LCD_V | can_set_lcd_filter -> set_lcd_filter; + _ -> return ()} + + glyph2' <- case gsrFormat glyph1' of { + FT_GLYPH_FORMAT_BITMAP -> return glyph1'; + _ -> withPtr glyph1' $ flip ft_Render_Glyph $ toEnum render_flags} + -- If set_lcd_filter requires mutex, release it here. + case gsrFormat glyph2' of { + FT_GLYPH_FORMAT_BITMAP -> return (); + _ -> throw $ FtError "glyphForIndex" 2 + } + + img <- cb $ gsrBitmap glyph2' + return Glyph { + glyphFontName = fontName font, glyphImage = img, + glyphAdvance = (fromIntegral (vX $ gsrAdvance glyph2') / 64 * + if fontPixelFixupEstimated font then fontPixelSizeFixup font else 1, + fromIntegral (vY $ gsrAdvance glyph2') / 64 * + if fontPixelFixupEstimated font then fontPixelSizeFixup font else 1), + glyphSubpixel = subpixel + } + +withPtr :: Storable a => a -> (Ptr a -> IO b) -> IO a +withPtr a cb = alloca $ \a' -> do + poke a' a + cb a' + peek a' + +isSuccess :: IO a -> IO Bool +isSuccess cb = do + cb + return True + `catch` \(FtError _ _) -> return False + m22toFt :: M22 Double -> FT_Matrix m22toFt (V2 (V2 xx xy) (V2 yx yy)) = FT_Matrix { mXx = c xx * 0x10000, mXy = c xy * 0x10000, -- 2.30.2