1 files changed, 96 insertions(+), 9 deletions(-)

M 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,