{-# LANGUAGE CApiFFI, OverloadedStrings #-}
-- | Convert between FontConfig & FreeType types.
module FreeType.FontConfig(charIndex,
        fontCharSet, fontCharSetAndSpacing, fontQuery, fontQueryAll, fontQueryFace,
        FTFC_Instance(..), FTFC_Metrics(..), FTFC_Subpixel(..), FTFC_Glyph(..),
        instantiatePattern, glyphForIndex, bmpAndMetricsForIndex) where

--import FreeType.Core.Base (FT_Face)

import Foreign.Ptr (Ptr)
import Foreign.C.String (CString)

import Graphics.Text.Font.Choose.CharSet (CharSet')
import Graphics.Text.Font.Choose.Pattern (Pattern, getValue, getValues)
import Graphics.Text.Font.Choose.FontSet (FontSet)
import Graphics.Text.Font.Choose.Internal.FFI (fromMessage0, withCString')

-- For FcFt transliteration
import Graphics.Text.Font.Choose.Value (Value(..))

import Data.Maybe (fromMaybe, fromJust)
import Linear.V2 (V2(..))
import Linear.Matrix(M22)
import Data.Bits ((.|.))
import Data.Word (Word32)

import Foreign.Storable (Storable(..))
import Control.Exception (catch, throw)
import Foreign.Marshal.Alloc (alloca)

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(..))

-- | Maps a Unicode char to a glyph index. This function uses information from
-- several possible underlying encoding tables to work around broken fonts.
-- As a result, this function isn't designed to be used in performance sensitive areas;
-- results from this function are intended to be cached by higher level functions.
foreign import capi "fontconfig-wrap.h fcFreeTypeCharIndex" charIndex :: FT_Face -> Char -> Word

-- | Scans a FreeType face and returns the set of encoded Unicode chars.
fontCharSet :: FT_Face -> CharSet'
fontCharSet :: FT_Face -> CharSet'
fontCharSet FT_Face
arg = (Ptr Int -> CString) -> CharSet'
forall a. MessagePack a => (Ptr Int -> CString) -> a
fromMessage0 ((Ptr Int -> CString) -> CharSet')
-> (Ptr Int -> CString) -> CharSet'
forall a b. (a -> b) -> a -> b
$ FT_Face -> Ptr Int -> CString
fcFreeTypeCharSet FT_Face
arg

foreign import capi "fontconfig-wrap.h" fcFreeTypeCharSet :: FT_Face -> Ptr Int -> CString

data Spacing = Mono -- ^ A font where all glyphs have the same width
    | Dual -- ^ The font has glyphs in precisely two widths
    | Proportional -- ^ The font has glyphs of many widths
    | SpacingError -- ^ Unexpected & invalid spacing value.
    deriving (ReadPrec [Spacing]
ReadPrec Spacing
Int -> ReadS Spacing
ReadS [Spacing]
(Int -> ReadS Spacing)
-> ReadS [Spacing]
-> ReadPrec Spacing
-> ReadPrec [Spacing]
-> Read Spacing
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Spacing
readsPrec :: Int -> ReadS Spacing
$creadList :: ReadS [Spacing]
readList :: ReadS [Spacing]
$creadPrec :: ReadPrec Spacing
readPrec :: ReadPrec Spacing
$creadListPrec :: ReadPrec [Spacing]
readListPrec :: ReadPrec [Spacing]
Read, Int -> Spacing -> ShowS
[Spacing] -> ShowS
Spacing -> FilePath
(Int -> Spacing -> ShowS)
-> (Spacing -> FilePath) -> ([Spacing] -> ShowS) -> Show Spacing
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Spacing -> ShowS
showsPrec :: Int -> Spacing -> ShowS
$cshow :: Spacing -> FilePath
show :: Spacing -> FilePath
$cshowList :: [Spacing] -> ShowS
showList :: [Spacing] -> ShowS
Show, Spacing -> Spacing -> Bool
(Spacing -> Spacing -> Bool)
-> (Spacing -> Spacing -> Bool) -> Eq Spacing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Spacing -> Spacing -> Bool
== :: Spacing -> Spacing -> Bool
$c/= :: Spacing -> Spacing -> Bool
/= :: Spacing -> Spacing -> Bool
Eq, Int -> Spacing
Spacing -> Int
Spacing -> [Spacing]
Spacing -> Spacing
Spacing -> Spacing -> [Spacing]
Spacing -> Spacing -> Spacing -> [Spacing]
(Spacing -> Spacing)
-> (Spacing -> Spacing)
-> (Int -> Spacing)
-> (Spacing -> Int)
-> (Spacing -> [Spacing])
-> (Spacing -> Spacing -> [Spacing])
-> (Spacing -> Spacing -> [Spacing])
-> (Spacing -> Spacing -> Spacing -> [Spacing])
-> Enum Spacing
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Spacing -> Spacing
succ :: Spacing -> Spacing
$cpred :: Spacing -> Spacing
pred :: Spacing -> Spacing
$ctoEnum :: Int -> Spacing
toEnum :: Int -> Spacing
$cfromEnum :: Spacing -> Int
fromEnum :: Spacing -> Int
$cenumFrom :: Spacing -> [Spacing]
enumFrom :: Spacing -> [Spacing]
$cenumFromThen :: Spacing -> Spacing -> [Spacing]
enumFromThen :: Spacing -> Spacing -> [Spacing]
$cenumFromTo :: Spacing -> Spacing -> [Spacing]
enumFromTo :: Spacing -> Spacing -> [Spacing]
$cenumFromThenTo :: Spacing -> Spacing -> Spacing -> [Spacing]
enumFromThenTo :: Spacing -> Spacing -> Spacing -> [Spacing]
Enum, Spacing
Spacing -> Spacing -> Bounded Spacing
forall a. a -> a -> Bounded a
$cminBound :: Spacing
minBound :: Spacing
$cmaxBound :: Spacing
maxBound :: Spacing
Bounded)

-- | Scans a FreeType face and returns the set of encoded Unicode chars & the computed spacing type.
fontCharSetAndSpacing :: FT_Face -> (Spacing, CharSet')
fontCharSetAndSpacing :: FT_Face -> (Spacing, CharSet')
fontCharSetAndSpacing FT_Face
arg = (Int -> Spacing
forall a. Enum a => Int -> a
toEnum Int
spacing, CharSet'
chars)
  where (Int
spacing, CharSet'
chars) = (Ptr Int -> CString) -> (Int, CharSet')
forall a. MessagePack a => (Ptr Int -> CString) -> a
fromMessage0 ((Ptr Int -> CString) -> (Int, CharSet'))
-> (Ptr Int -> CString) -> (Int, CharSet')
forall a b. (a -> b) -> a -> b
$ FT_Face -> Ptr Int -> CString
fcFreeTypeCharSetAndSpacing FT_Face
arg

foreign import capi "fontconfig-wrap.h" fcFreeTypeCharSetAndSpacing ::
    FT_Face -> Ptr Int -> CString

-- | Constructs a pattern representing the 'id'th face in 'file'.
-- The number of faces in 'file' is returned in 'count'.
fontQuery :: FilePath -> Int -> (Int, Pattern)
fontQuery :: FilePath -> Int -> (Int, Pattern)
fontQuery FilePath
a Int
b = (Ptr Int -> CString) -> (Int, Pattern)
forall a. MessagePack a => (Ptr Int -> CString) -> a
fromMessage0 ((Ptr Int -> CString) -> (Int, Pattern))
-> (Ptr Int -> CString) -> (Int, Pattern)
forall a b. (a -> b) -> a -> b
$ ((CString -> Ptr Int -> CString) -> FilePath -> Ptr Int -> CString)
-> FilePath
-> (CString -> Ptr Int -> CString)
-> Ptr Int
-> CString
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CString -> Ptr Int -> CString) -> FilePath -> Ptr Int -> CString
forall a. (CString -> a) -> FilePath -> a
withCString' FilePath
a ((CString -> Ptr Int -> CString) -> Ptr Int -> CString)
-> (CString -> Ptr Int -> CString) -> Ptr Int -> CString
forall a b. (a -> b) -> a -> b
$ \CString
a' -> CString -> Int -> Ptr Int -> CString
fcFreeTypeQuery CString
a' Int
b

foreign import capi "fontconfig-wrap.h" fcFreeTypeQuery ::
    CString -> Int -> Ptr Int -> CString

-- | Constructs patterns found in 'file', all patterns found in 'file' are added to 'set'.
-- The number of faces in 'file' is returned in 'count'.
-- The number of patterns added to 'set' is returned.
fontQueryAll :: FilePath -> (Int, Int, FontSet)
fontQueryAll :: FilePath -> (Int, Int, FontSet)
fontQueryAll FilePath
a = (Ptr Int -> CString) -> (Int, Int, FontSet)
forall a. MessagePack a => (Ptr Int -> CString) -> a
fromMessage0 ((Ptr Int -> CString) -> (Int, Int, FontSet))
-> (Ptr Int -> CString) -> (Int, Int, FontSet)
forall a b. (a -> b) -> a -> b
$ (CString -> Ptr Int -> CString) -> FilePath -> Ptr Int -> CString
forall a. (CString -> a) -> FilePath -> a
withCString' CString -> Ptr Int -> CString
fcFreeTypeQueryAll FilePath
a

foreign import capi "fontconfig-wrap.h" fcFreeTypeQueryAll ::
    CString -> Ptr Int -> CString

-- | Constructs a pattern representing 'face'. 'file' and 'id' are used solely
-- as data for pattern elements (FC_FILE, FC_INDEX and sometimes FC_FAMILY).
fontQueryFace :: FT_Face -> FilePath -> Int -> Pattern
fontQueryFace :: FT_Face -> FilePath -> Int -> Pattern
fontQueryFace FT_Face
a FilePath
b Int
c = (Ptr Int -> CString) -> Pattern
forall a. MessagePack a => (Ptr Int -> CString) -> a
fromMessage0 ((Ptr Int -> CString) -> Pattern)
-> (Ptr Int -> CString) -> Pattern
forall a b. (a -> b) -> a -> b
$ ((CString -> Ptr Int -> CString) -> FilePath -> Ptr Int -> CString)
-> FilePath
-> (CString -> Ptr Int -> CString)
-> Ptr Int
-> CString
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CString -> Ptr Int -> CString) -> FilePath -> Ptr Int -> CString
forall a. (CString -> a) -> FilePath -> a
withCString' FilePath
b ((CString -> Ptr Int -> CString) -> Ptr Int -> CString)
-> (CString -> Ptr Int -> CString) -> Ptr Int -> CString
forall a b. (a -> b) -> a -> b
$ \CString
b' -> FT_Face -> CString -> Int -> Ptr Int -> CString
fcFreeTypeQueryFace FT_Face
a CString
b' (Int -> Ptr Int -> CString) -> Int -> Ptr Int -> CString
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
c

foreign import capi "fontconfig-wrap.h" fcFreeTypeQueryFace ::
    FT_Face -> CString -> Int -> Ptr Int -> CString

------
--- Transliterated from FcFt
--- https://codeberg.org/dnkl/fcft/
--- Untested
------

-- | A `FT_Face` queried from FontConfig with glyph-loading parameters.
data FTFC_Instance = Instance {
    FTFC_Instance -> Maybe FilePath
fontName :: Maybe String,
    FTFC_Instance -> Maybe FilePath
fontPath :: Maybe String,
    FTFC_Instance -> FT_Face
fontFace :: FT_Face,
    FTFC_Instance -> Int
fontLoadFlags :: Int,
    FTFC_Instance -> Bool
fontAntialias :: Bool,
    FTFC_Instance -> Bool
fontEmbolden :: Bool,
    FTFC_Instance -> Bool
fontIsColor :: Bool,
    FTFC_Instance -> Int
fontRenderFlags :: Int,
    FTFC_Instance -> Int
fontRenderFlagsSubpixel :: Int,
    FTFC_Instance -> Double
fontPixelSizeFixup :: Double,
    FTFC_Instance -> Bool
fontPixelFixupEstimated :: Bool,
    FTFC_Instance -> Bool
fontBGR :: Bool,
    FTFC_Instance -> FT_UInt
fontLCDFilter :: FT_LcdFilter,
    FTFC_Instance -> [FilePath]
fontFeats :: [String], -- Callers probably want to validate via harfbuzz
    FTFC_Instance -> FTFC_Metrics
fontMetrics :: FTFC_Metrics
}
-- | Results queried from FontConfig with caller-relevant properties,
-- notably relating to layout.
data FTFC_Metrics = Metrics {
    FTFC_Metrics -> Int
height :: Int,
    FTFC_Metrics -> Int
descent :: Int,
    FTFC_Metrics -> Int
ascent :: Int,
    FTFC_Metrics -> (Int, Int)
maxAdvance :: (Int, Int), -- Width/height of font's widest glyph.
    FTFC_Metrics -> Bool
metricsAntialias :: Bool,
    FTFC_Metrics -> FTFC_Subpixel
metricsSubpixel :: FTFC_Subpixel,
    FTFC_Metrics -> Maybe FilePath
metricsName :: Maybe String
}
-- | Defines subpixel order to use.
-- Note that this is *ignored* if antialiasing has been disabled.
data FTFC_Subpixel = SubpixelNone -- ^ From FontConfig.
    | SubpixelHorizontalRGB | SubpixelHorizontalBGR |
    SubpixelVerticalRGB | SubpixelVerticalBGR
    | SubpixelDefault -- ^ Disable subpixel antialiasing.

-- | Converts the results of a FontConfig query requesting a specific size
-- into a `FT_Face` & related properties.
-- Throw exceptions.
instantiatePattern :: FT_Library -> Pattern -> (Double, Double) -> IO FTFC_Instance
instantiatePattern :: FT_Library -> Pattern -> (Double, Double) -> IO FTFC_Instance
instantiatePattern FT_Library
ftlib Pattern
pattern (Double
req_pt_size, Double
req_px_size) = do
    let dpi :: Double
dpi = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
75 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe Double
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"dpi" Pattern
pattern :: Double

    FT_Face
ft_face <- case () of --getValue "ftface" pattern of
        -- ValueFTFace x -> return x
        ()
_ -> FT_Library -> FilePath -> FT_Fixed -> IO FT_Face
ft_New_Face FT_Library
ftlib (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe FilePath
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"file" Pattern
pattern) -- is a mutex needed?
            (Int -> FT_Fixed
forall a. Enum a => Int -> a
toEnum (Int -> FT_Fixed) -> Int -> FT_Fixed
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe Int
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"index" Pattern
pattern)

    FT_Face -> FT_UInt -> FT_UInt -> IO ()
ft_Set_Pixel_Sizes FT_Face
ft_face FT_UInt
0 (FT_UInt -> IO ()) -> FT_UInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> FT_UInt
forall a. Enum a => Int -> a
toEnum (Int -> FT_UInt) -> Int -> FT_UInt
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a. Enum a => a -> Int
fromEnum (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$
        Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
req_px_size (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe Double
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"pixelsize" Pattern
pattern
    let scalable :: Bool
scalable = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe Bool
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"scalable" Pattern
pattern
    let outline :: Bool
outline = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe Bool
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"outline" Pattern
pattern
    (Double
pixel_fixup, Bool
fixup_estimated) <- case Text -> Pattern -> Maybe Value
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"pixelsizefixupfactor" Pattern
pattern of
        Just (ValueDouble Double
x) -> (Double, Bool) -> IO (Double, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Bool
False)
        Maybe Value
_ | Bool
scalable Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
outline -> do
            let px_size :: Double
px_size = if Double
req_px_size Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 then Double
req_pt_size Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dpi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
72 else Double
req_px_size
            FT_FaceRec
ft_face' <- FT_Face -> IO FT_FaceRec
forall a. Storable a => Ptr a -> IO a
peek FT_Face
ft_face
            FT_SizeRec
size' <- Ptr FT_SizeRec -> IO FT_SizeRec
forall a. Storable a => Ptr a -> IO a
peek (Ptr FT_SizeRec -> IO FT_SizeRec)
-> Ptr FT_SizeRec -> IO FT_SizeRec
forall a b. (a -> b) -> a -> b
$ FT_FaceRec -> Ptr FT_SizeRec
frSize FT_FaceRec
ft_face'
            (Double, Bool) -> IO (Double, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
px_size Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (FT_UShort -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FT_UShort -> Double) -> FT_UShort -> Double
forall a b. (a -> b) -> a -> b
$ FT_Size_Metrics -> FT_UShort
smY_ppem (FT_Size_Metrics -> FT_UShort) -> FT_Size_Metrics -> FT_UShort
forall a b. (a -> b) -> a -> b
$ FT_SizeRec -> FT_Size_Metrics
srMetrics FT_SizeRec
size'), Bool
True)
        Maybe Value
_ -> (Double, Bool) -> IO (Double, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
1, Bool
False)

    let hinting :: Bool
hinting = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe Bool
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"hinting" Pattern
pattern
    let antialias :: Bool
antialias = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe Bool
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"antialias" Pattern
pattern
    let hintstyle :: Int
hintstyle = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe Int
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"hintstyle" Pattern
pattern :: Int
    let rgba :: Int
rgba = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe Int
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"rgba" Pattern
pattern :: Int
    let load_flags :: Int
load_flags | Bool -> Bool
not Bool
antialias Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
hinting Bool -> Bool -> Bool
|| Int
hintstyle Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) =
                        Int
ft_LOAD_NO_HINTING Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
ft_LOAD_MONOCHROME
                   | Bool -> Bool
not Bool
antialias = Int
ft_LOAD_MONOCHROME
                   | Bool -> Bool
not Bool
hinting Bool -> Bool -> Bool
|| Int
hintstyle Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
ft_LOAD_NO_HINTING
                   | Bool
otherwise = Int
ft_LOAD_DEFAULT
    let load_target :: Int
load_target | Bool -> Bool
not Bool
antialias Bool -> Bool -> Bool
&& Bool
hinting Bool -> Bool -> Bool
&& Int
hintstyle Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Int
ft_LOAD_TARGET_MONO
                    | Bool -> Bool
not Bool
antialias = Int
ft_LOAD_TARGET_NORMAL
                    | Bool -> Bool
not Bool
hinting Bool -> Bool -> Bool
|| Int
hintstyle Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
ft_LOAD_TARGET_NORMAL
                    | Int
hintstyle Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Int
ft_LOAD_TARGET_LIGHT
                    | Int
hintstyle Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = Int
ft_LOAD_TARGET_NORMAL
                    | Int
rgba Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1, Int
2] = Int
ft_LOAD_TARGET_LCD
                    | Int
rgba Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
3, Int
4] = Int
ft_LOAD_TARGET_LCD_V
                    | Bool
otherwise = Int
ft_LOAD_TARGET_NORMAL

    --let embedded_bitmap = fromMaybe True $ getValue "embeddedbitmap" pattern
    --let load_flags1 | embedded_bitmap = load_flags .|. ft_LOAD_NO_BITMAP
    --                | otherwise = load_flags
    --let autohint = fromMaybe False $ getValue "autohint" pattern
    --let load_flags2 | autohint = load_flags .|. ft_LOAD_FORCE_AUTOHINT
    --                | otherwise = load_flags
    let render_flags_normal :: Int
render_flags_normal | Bool -> Bool
not Bool
antialias = Int
ft_RENDER_MODE_MONO
                            | Bool
otherwise = Int
ft_RENDER_MODE_NORMAL
    let render_flags_subpixel :: Int
render_flags_subpixel | Bool -> Bool
not Bool
antialias = Int
ft_RENDER_MODE_MONO
                              | Int
rgba Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1, Int
2] = Int
ft_RENDER_MODE_LCD
                              | Int
rgba Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
3, Int
4] = Int
ft_RENDER_MODE_LCD_V
                              | Bool
otherwise = Int
ft_RENDER_MODE_NORMAL

    let lcdfilter :: Int
        lcdfilter :: Int
lcdfilter = case Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe Int
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"lcdfilter" Pattern
pattern of
            Int
3 -> Int
16
            Int
x -> Int
x
    case Text -> Pattern -> Maybe Value
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"matrix" Pattern
pattern of
        Just (ValueMatrix M22 Double
m) -> FT_Face -> Maybe FT_Matrix -> Maybe FT_Vector -> IO ()
ft_Set_Transform FT_Face
ft_face (FT_Matrix -> Maybe FT_Matrix
forall a. a -> Maybe a
Just (FT_Matrix -> Maybe FT_Matrix) -> FT_Matrix -> Maybe FT_Matrix
forall a b. (a -> b) -> a -> b
$ M22 Double -> FT_Matrix
m22toFt M22 Double
m) Maybe FT_Vector
forall a. Maybe a
Nothing
        Maybe Value
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    FT_FaceRec
ft_face' <- FT_Face -> IO FT_FaceRec
forall a. Storable a => Ptr a -> IO a
peek FT_Face
ft_face
    FT_SizeRec
size' <- Ptr FT_SizeRec -> IO FT_SizeRec
forall a. Storable a => Ptr a -> IO a
peek (Ptr FT_SizeRec -> IO FT_SizeRec)
-> Ptr FT_SizeRec -> IO FT_SizeRec
forall a b. (a -> b) -> a -> b
$ FT_FaceRec -> Ptr FT_SizeRec
frSize FT_FaceRec
ft_face'
    let metrics' :: FT_Size_Metrics
metrics' = FT_SizeRec -> FT_Size_Metrics
srMetrics FT_SizeRec
size'
    let c :: a -> Double
c a
x = a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
64 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pixel_fixup
    FTFC_Instance -> IO FTFC_Instance
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Instance {
        fontName :: Maybe FilePath
fontName = Text -> Pattern -> Maybe FilePath
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"fullname" Pattern
pattern,
        fontPath :: Maybe FilePath
fontPath = Text -> Pattern -> Maybe FilePath
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"file" Pattern
pattern,
        fontFace :: FT_Face
fontFace = FT_Face
ft_face,
        fontLoadFlags :: Int
fontLoadFlags = Int
load_target Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
load_flags Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
ft_LOAD_COLOR,
        fontAntialias :: Bool
fontAntialias = Bool
antialias,
        fontEmbolden :: Bool
fontEmbolden = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe Bool
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"embolden" Pattern
pattern,
        fontIsColor :: Bool
fontIsColor = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Maybe Bool
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"color" Pattern
pattern,
        fontRenderFlags :: Int
fontRenderFlags = Int
render_flags_normal,
        fontRenderFlagsSubpixel :: Int
fontRenderFlagsSubpixel = Int
render_flags_subpixel,
        fontPixelSizeFixup :: Double
fontPixelSizeFixup = Double
pixel_fixup,
        fontPixelFixupEstimated :: Bool
fontPixelFixupEstimated = Bool
fixup_estimated,
        fontBGR :: Bool
fontBGR = Int
rgba Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
2, Int
4],
        fontLCDFilter :: FT_UInt
fontLCDFilter = Int -> FT_UInt
forall a. Enum a => Int -> a
toEnum Int
lcdfilter,
        fontFeats :: [FilePath]
fontFeats = Text -> Pattern -> [FilePath]
forall v. ToValue v => Text -> Pattern -> [v]
getValues Text
"fontfeatures" Pattern
pattern,
        fontMetrics :: FTFC_Metrics
fontMetrics = Metrics {
            height :: Int
height = Double -> Int
forall a. Enum a => a -> Int
fromEnum (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ FT_Fixed -> Double
forall {a}. Integral a => a -> Double
c (FT_Fixed -> Double) -> FT_Fixed -> Double
forall a b. (a -> b) -> a -> b
$ FT_Size_Metrics -> FT_Fixed
smHeight FT_Size_Metrics
metrics',
            descent :: Int
descent = Double -> Int
forall a. Enum a => a -> Int
fromEnum (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ FT_Fixed -> Double
forall {a}. Integral a => a -> Double
c (FT_Fixed -> Double) -> FT_Fixed -> Double
forall a b. (a -> b) -> a -> b
$ FT_Size_Metrics -> FT_Fixed
smDescender FT_Size_Metrics
metrics',
            ascent :: Int
ascent = Double -> Int
forall a. Enum a => a -> Int
fromEnum (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ FT_Fixed -> Double
forall {a}. Integral a => a -> Double
c (FT_Fixed -> Double) -> FT_Fixed -> Double
forall a b. (a -> b) -> a -> b
$ FT_Size_Metrics -> FT_Fixed
smAscender FT_Size_Metrics
metrics',
            maxAdvance :: (Int, Int)
maxAdvance = (Double -> Int
forall a. Enum a => a -> Int
fromEnum (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ FT_Fixed -> Double
forall {a}. Integral a => a -> Double
c (FT_Fixed -> Double) -> FT_Fixed -> Double
forall a b. (a -> b) -> a -> b
$ FT_Size_Metrics -> FT_Fixed
smMax_advance FT_Size_Metrics
metrics',
                Double -> Int
forall a. Enum a => a -> Int
fromEnum (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ FT_Fixed -> Double
forall {a}. Integral a => a -> Double
c (FT_Fixed -> Double) -> FT_Fixed -> Double
forall a b. (a -> b) -> a -> b
$ FT_Size_Metrics -> FT_Fixed
smHeight FT_Size_Metrics
metrics'),
            metricsAntialias :: Bool
metricsAntialias = Bool
antialias,
            metricsSubpixel :: FTFC_Subpixel
metricsSubpixel = case Int
rgba of
                Int
_ | Bool -> Bool
not Bool
antialias -> FTFC_Subpixel
SubpixelNone
                Int
1 -> FTFC_Subpixel
SubpixelHorizontalRGB
                Int
2 -> FTFC_Subpixel
SubpixelHorizontalBGR
                Int
3 -> FTFC_Subpixel
SubpixelVerticalRGB
                Int
4 -> FTFC_Subpixel
SubpixelVerticalBGR
                Int
_ -> FTFC_Subpixel
SubpixelNone,
            metricsName :: Maybe FilePath
metricsName = Text -> Pattern -> Maybe FilePath
forall v. ToValue v => Text -> Pattern -> Maybe v
getValue Text
"fullname" Pattern
pattern
        }
      }

-- | Results from `glyphForIndex`.
data FTFC_Glyph a = Glyph {
    forall a. FTFC_Glyph a -> Maybe FilePath
glyphFontName :: Maybe String,
    forall a. FTFC_Glyph a -> a
glyphImage :: a,
    forall a. FTFC_Glyph a -> (Double, Double)
glyphAdvance :: (Double, Double),
    forall a. FTFC_Glyph a -> FTFC_Subpixel
glyphSubpixel :: FTFC_Subpixel,
    forall a. FTFC_Glyph a -> FT_Glyph_Metrics
glyphMetrics :: FT_Glyph_Metrics
}

-- | Looks up a given glyph in a `FTFC_Instance` & its underlying `FT_Face`
-- Taking into account additional properties from FontConfig.
-- Runs a provided callback to render the glyph into a reusable datastructure.
-- The `FT_Bitmap` given to this callback must not be used outside it.
-- Throws exceptions.
glyphForIndex :: FTFC_Instance -> Word32 -> FTFC_Subpixel -> 
    (FT_Bitmap -> IO a) -> IO (FTFC_Glyph a)
glyphForIndex :: forall a.
FTFC_Instance
-> FT_UInt
-> FTFC_Subpixel
-> (FT_Bitmap -> IO a)
-> IO (FTFC_Glyph a)
glyphForIndex FTFC_Instance
font FT_UInt
index FTFC_Subpixel
subpixel FT_Bitmap -> IO a
cb = do
    FT_Face -> FT_UInt -> FT_Int32 -> IO ()
ft_Load_Glyph (FTFC_Instance -> FT_Face
fontFace FTFC_Instance
font) FT_UInt
index (Int -> FT_Int32
forall a. Enum a => Int -> a
toEnum (Int -> FT_Int32) -> Int -> FT_Int32
forall a b. (a -> b) -> a -> b
$ FTFC_Instance -> Int
fontLoadFlags FTFC_Instance
font)
    FT_FaceRec
face' <- FT_Face -> IO FT_FaceRec
forall a. Storable a => Ptr a -> IO a
peek (FT_Face -> IO FT_FaceRec) -> FT_Face -> IO FT_FaceRec
forall a b. (a -> b) -> a -> b
$ FTFC_Instance -> FT_Face
fontFace FTFC_Instance
font
    FT_SizeRec
size' <- Ptr FT_SizeRec -> IO FT_SizeRec
forall a. Storable a => Ptr a -> IO a
peek (Ptr FT_SizeRec -> IO FT_SizeRec)
-> Ptr FT_SizeRec -> IO FT_SizeRec
forall a b. (a -> b) -> a -> b
$ FT_FaceRec -> Ptr FT_SizeRec
frSize FT_FaceRec
face'
    -- Formula from old FreeType function `FT_GlyphSlotEmbolden`.
    -- Approximate as fallback for fonts not using fontsets or variables axis.
    let strength :: FT_Fixed
strength = FT_UShort -> FT_Fixed
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FT_FaceRec -> FT_UShort
frUnits_per_EM FT_FaceRec
face')FT_Fixed -> FT_Fixed -> FT_Fixed
forall a. Num a => a -> a -> a
*FT_Size_Metrics -> FT_Fixed
smY_scale (FT_SizeRec -> FT_Size_Metrics
srMetrics FT_SizeRec
size')FT_Fixed -> FT_Fixed -> FT_Fixed
forall a. Integral a => a -> a -> a
`div`FT_Fixed
24
    FT_GlyphSlotRec
glyph' <- Ptr FT_GlyphSlotRec -> IO FT_GlyphSlotRec
forall a. Storable a => Ptr a -> IO a
peek (Ptr FT_GlyphSlotRec -> IO FT_GlyphSlotRec)
-> Ptr FT_GlyphSlotRec -> IO FT_GlyphSlotRec
forall a b. (a -> b) -> a -> b
$ FT_FaceRec -> Ptr FT_GlyphSlotRec
frGlyph FT_FaceRec
face'

    FT_GlyphSlotRec
glyph1' <- case FT_GlyphSlotRec -> FT_UInt
gsrFormat FT_GlyphSlotRec
glyph' of
        FT_UInt
FT_GLYPH_FORMAT_OUTLINE | FTFC_Instance -> Bool
fontEmbolden FTFC_Instance
font -> do
            FT_Outline
outline <- FT_Outline -> (Ptr FT_Outline -> IO ()) -> IO FT_Outline
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO a
withPtr (FT_GlyphSlotRec -> FT_Outline
gsrOutline FT_GlyphSlotRec
glyph') ((Ptr FT_Outline -> IO ()) -> IO FT_Outline)
-> (Ptr FT_Outline -> IO ()) -> IO FT_Outline
forall a b. (a -> b) -> a -> b
$ (Ptr FT_Outline -> FT_Fixed -> IO ())
-> FT_Fixed -> Ptr FT_Outline -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr FT_Outline -> FT_Fixed -> IO ()
ft_Outline_Embolden FT_Fixed
strength
            FT_GlyphSlotRec -> IO FT_GlyphSlotRec
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FT_GlyphSlotRec
glyph' { gsrOutline :: FT_Outline
gsrOutline = FT_Outline
outline }
        FT_UInt
_ -> FT_GlyphSlotRec -> IO FT_GlyphSlotRec
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FT_GlyphSlotRec
glyph'

    let render_flags :: Int
render_flags = case FTFC_Subpixel
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;
        FTFC_Subpixel
_ | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FTFC_Instance -> Bool
fontAntialias FTFC_Instance
font -> FTFC_Instance -> Int
fontRenderFlags FTFC_Instance
font;
        FTFC_Subpixel
SubpixelNone -> FTFC_Instance -> Int
fontRenderFlags FTFC_Instance
font;
        FTFC_Subpixel
SubpixelHorizontalRGB -> Int
ft_RENDER_MODE_LCD;
        FTFC_Subpixel
SubpixelHorizontalBGR -> Int
ft_RENDER_MODE_LCD;
        FTFC_Subpixel
SubpixelVerticalRGB -> Int
ft_RENDER_MODE_LCD_V;
        FTFC_Subpixel
SubpixelVerticalBGR -> Int
ft_RENDER_MODE_LCD_V;
        FTFC_Subpixel
SubpixelDefault -> FTFC_Instance -> Int
fontRenderFlagsSubpixel FTFC_Instance
font}
    {-let bgr = case subpixel of
            _ | not $ fontAntialias font -> False
            SubpixelNone -> False
            SubpixelHorizontalRGB -> False
            SubpixelHorizontalBGR -> True
            SubpixelVerticalRGB -> False
            SubpixelVerticalBGR -> True
            SubpixelDefault -> fontBGR font-}

    Bool
can_set_lcd_filter <- IO () -> IO Bool
forall a. IO a -> IO Bool
isSuccess (IO () -> IO Bool) -> IO () -> IO Bool
forall a b. (a -> b) -> a -> b
$ FT_Library -> FT_UInt -> IO ()
ft_Library_SetLcdFilter (FT_GlyphSlotRec -> FT_Library
gsrLibrary FT_GlyphSlotRec
glyph1') FT_UInt
0
    -- FIXME: Do we need a mutex?
    let set_lcd_filter :: IO ()
set_lcd_filter = FT_Library -> FT_UInt -> IO ()
ft_Library_SetLcdFilter (FT_GlyphSlotRec -> FT_Library
gsrLibrary FT_GlyphSlotRec
glyph1') (FT_UInt -> IO ()) -> FT_UInt -> IO ()
forall a b. (a -> b) -> a -> b
$ FTFC_Instance -> FT_UInt
fontLCDFilter FTFC_Instance
font
    case Int
render_flags of {
        Int
FT_RENDER_MODE_LCD | Bool
can_set_lcd_filter -> IO ()
set_lcd_filter;
        Int
FT_RENDER_MODE_LCD_V | Bool
can_set_lcd_filter -> IO ()
set_lcd_filter;
        Int
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()}

    FT_GlyphSlotRec
glyph2' <- case FT_GlyphSlotRec -> FT_UInt
gsrFormat FT_GlyphSlotRec
glyph1' of {
        FT_UInt
FT_GLYPH_FORMAT_BITMAP -> FT_GlyphSlotRec -> IO FT_GlyphSlotRec
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FT_GlyphSlotRec
glyph1';
        FT_UInt
_ -> FT_GlyphSlotRec
-> (Ptr FT_GlyphSlotRec -> IO ()) -> IO FT_GlyphSlotRec
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO a
withPtr FT_GlyphSlotRec
glyph1' ((Ptr FT_GlyphSlotRec -> IO ()) -> IO FT_GlyphSlotRec)
-> (Ptr FT_GlyphSlotRec -> IO ()) -> IO FT_GlyphSlotRec
forall a b. (a -> b) -> a -> b
$ (Ptr FT_GlyphSlotRec -> FT_UInt -> IO ())
-> FT_UInt -> Ptr FT_GlyphSlotRec -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr FT_GlyphSlotRec -> FT_UInt -> IO ()
ft_Render_Glyph (FT_UInt -> Ptr FT_GlyphSlotRec -> IO ())
-> FT_UInt -> Ptr FT_GlyphSlotRec -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> FT_UInt
forall a. Enum a => Int -> a
toEnum Int
render_flags}
    -- If set_lcd_filter requires mutex, release it here.
    case FT_GlyphSlotRec -> FT_UInt
gsrFormat FT_GlyphSlotRec
glyph2' of {
        FT_UInt
FT_GLYPH_FORMAT_BITMAP -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ();
        FT_UInt
_ -> FtError -> IO ()
forall a e. Exception e => e -> a
throw (FtError -> IO ()) -> FtError -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FT_Int32 -> FtError
FtError FilePath
"glyphForIndex" FT_Int32
2
    }

    a
img <- FT_Bitmap -> IO a
cb (FT_Bitmap -> IO a) -> FT_Bitmap -> IO a
forall a b. (a -> b) -> a -> b
$ FT_GlyphSlotRec -> FT_Bitmap
gsrBitmap FT_GlyphSlotRec
glyph2'
    FTFC_Glyph a -> IO (FTFC_Glyph a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Glyph {
        glyphFontName :: Maybe FilePath
glyphFontName = FTFC_Instance -> Maybe FilePath
fontName FTFC_Instance
font, glyphImage :: a
glyphImage = a
img,
        glyphAdvance :: (Double, Double)
glyphAdvance = (FT_Fixed -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FT_Vector -> FT_Fixed
vX (FT_Vector -> FT_Fixed) -> FT_Vector -> FT_Fixed
forall a b. (a -> b) -> a -> b
$ FT_GlyphSlotRec -> FT_Vector
gsrAdvance FT_GlyphSlotRec
glyph2') Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
64 Double -> Double -> Double
forall a. Num a => a -> a -> a
*
            if FTFC_Instance -> Bool
fontPixelFixupEstimated FTFC_Instance
font then FTFC_Instance -> Double
fontPixelSizeFixup FTFC_Instance
font else Double
1,
            FT_Fixed -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FT_Vector -> FT_Fixed
vY (FT_Vector -> FT_Fixed) -> FT_Vector -> FT_Fixed
forall a b. (a -> b) -> a -> b
$ FT_GlyphSlotRec -> FT_Vector
gsrAdvance FT_GlyphSlotRec
glyph2') Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
64 Double -> Double -> Double
forall a. Num a => a -> a -> a
*
            if FTFC_Instance -> Bool
fontPixelFixupEstimated FTFC_Instance
font then FTFC_Instance -> Double
fontPixelSizeFixup FTFC_Instance
font else Double
1),
        glyphSubpixel :: FTFC_Subpixel
glyphSubpixel = FTFC_Subpixel
subpixel,
        glyphMetrics :: FT_Glyph_Metrics
glyphMetrics = FT_GlyphSlotRec -> FT_Glyph_Metrics
gsrMetrics FT_GlyphSlotRec
glyph2'
    }

-- | Convience API around `glyphForIndex` to retrieve the image & metrics of the font's glyph.
bmpAndMetricsForIndex ::
    FTFC_Instance -> FTFC_Subpixel -> Word32 -> IO (FT_Bitmap, FT_Glyph_Metrics)
bmpAndMetricsForIndex :: FTFC_Instance
-> FTFC_Subpixel -> FT_UInt -> IO (FT_Bitmap, FT_Glyph_Metrics)
bmpAndMetricsForIndex FTFC_Instance
inst FTFC_Subpixel
subpixel FT_UInt
index = do
    FTFC_Glyph FT_Bitmap
glyph <- FTFC_Instance
-> FT_UInt
-> FTFC_Subpixel
-> (FT_Bitmap -> IO FT_Bitmap)
-> IO (FTFC_Glyph FT_Bitmap)
forall a.
FTFC_Instance
-> FT_UInt
-> FTFC_Subpixel
-> (FT_Bitmap -> IO a)
-> IO (FTFC_Glyph a)
glyphForIndex FTFC_Instance
inst FT_UInt
index FTFC_Subpixel
subpixel FT_Bitmap -> IO FT_Bitmap
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (FT_Bitmap, FT_Glyph_Metrics) -> IO (FT_Bitmap, FT_Glyph_Metrics)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FTFC_Glyph FT_Bitmap -> FT_Bitmap
forall a. FTFC_Glyph a -> a
glyphImage FTFC_Glyph FT_Bitmap
glyph, FTFC_Glyph FT_Bitmap -> FT_Glyph_Metrics
forall a. FTFC_Glyph a -> FT_Glyph_Metrics
glyphMetrics FTFC_Glyph FT_Bitmap
glyph)

withPtr :: Storable a => a -> (Ptr a -> IO b) -> IO a
withPtr :: forall a b. Storable a => a -> (Ptr a -> IO b) -> IO a
withPtr a
a Ptr a -> IO b
cb = (Ptr a -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr a
a' -> do
    Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
a' a
a
    b
_ <- Ptr a -> IO b
cb Ptr a
a'
    Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
a'

isSuccess :: IO a -> IO Bool
isSuccess :: forall a. IO a -> IO Bool
isSuccess IO a
cb = do
    a
_ <- IO a
cb
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  IO Bool -> (FtError -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(FtError FilePath
_ FT_Int32
_) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

m22toFt :: M22 Double -> FT_Matrix
m22toFt :: M22 Double -> FT_Matrix
m22toFt (V2 (V2 Double
xx Double
xy) (V2 Double
yx Double
yy)) = FT_Matrix {
    mXx :: FT_Fixed
mXx = Double -> FT_Fixed
c Double
xx FT_Fixed -> FT_Fixed -> FT_Fixed
forall a. Num a => a -> a -> a
* FT_Fixed
0x10000, mXy :: FT_Fixed
mXy = Double -> FT_Fixed
c Double
xy FT_Fixed -> FT_Fixed -> FT_Fixed
forall a. Num a => a -> a -> a
* FT_Fixed
0x10000,
    mYx :: FT_Fixed
mYx = Double -> FT_Fixed
c Double
yx FT_Fixed -> FT_Fixed -> FT_Fixed
forall a. Num a => a -> a -> a
* FT_Fixed
0x10000, mYy :: FT_Fixed
mYy = Double -> FT_Fixed
c Double
yy FT_Fixed -> FT_Fixed -> FT_Fixed
forall a. Num a => a -> a -> a
* FT_Fixed
0x10000
  } where c :: Double -> FT_Fixed
c = Int -> FT_Fixed
forall a. Enum a => Int -> a
toEnum (Int -> FT_Fixed) -> (Double -> Int) -> Double -> FT_Fixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a. Enum a => a -> Int
fromEnum

-- Taken from FreeType language bindings,
-- but converted to constants rather than pattern synonyms.
ft_LOAD_DEFAULT, {-ft_LOAD_NO_SCALE,-} ft_LOAD_NO_HINTING, {-ft_LOAD_RENDER,
    ft_LOAD_NO_BITMAP, ft_LOAD_VERTICAL_LAYOUT, ft_LOAD_FORCE_AUTOHINT,
    ft_LOAD_CROP_BITMAP, ft_LOAD_PEDANTIC, ft_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH,
    ft_LOAD_NO_RECURSE, ft_LOAD_IGNORE_TRANSFORM,-} ft_LOAD_MONOCHROME,
    {-ft_LOAD_LINEAR_DESIGN, ft_LOAD_NO_AUTOHINT,-} ft_LOAD_COLOR{-,
    ft_LOAD_COMPUTE_METRICS, ft_LOAD_BITMAP_METRICS_ONLY-} :: Int
ft_LOAD_DEFAULT :: Int
ft_LOAD_DEFAULT                     = Int
0
--ft_LOAD_NO_SCALE                    = 1
ft_LOAD_NO_HINTING :: Int
ft_LOAD_NO_HINTING                  = Int
2
--ft_LOAD_RENDER                      = 4
--ft_LOAD_NO_BITMAP                   = 8
--ft_LOAD_VERTICAL_LAYOUT             = 16
--ft_LOAD_FORCE_AUTOHINT              = 32
--ft_LOAD_CROP_BITMAP                 = 64
--ft_LOAD_PEDANTIC                    = 128
--ft_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH = 512
--ft_LOAD_NO_RECURSE                  = 1024
--ft_LOAD_IGNORE_TRANSFORM            = 2048
ft_LOAD_MONOCHROME :: Int
ft_LOAD_MONOCHROME                  = Int
4096
--ft_LOAD_LINEAR_DESIGN               = 8192
--ft_LOAD_NO_AUTOHINT                 = 32768
ft_LOAD_COLOR :: Int
ft_LOAD_COLOR                       = Int
1048576
--ft_LOAD_COMPUTE_METRICS             = 2097152
--ft_LOAD_BITMAP_METRICS_ONLY         = 4194304

ft_LOAD_TARGET_NORMAL, ft_LOAD_TARGET_LIGHT, ft_LOAD_TARGET_MONO,
    ft_LOAD_TARGET_LCD, ft_LOAD_TARGET_LCD_V :: Int
ft_LOAD_TARGET_NORMAL :: Int
ft_LOAD_TARGET_NORMAL = Int
0
ft_LOAD_TARGET_LIGHT :: Int
ft_LOAD_TARGET_LIGHT  = Int
65536
ft_LOAD_TARGET_MONO :: Int
ft_LOAD_TARGET_MONO   = Int
131072
ft_LOAD_TARGET_LCD :: Int
ft_LOAD_TARGET_LCD    = Int
196608
ft_LOAD_TARGET_LCD_V :: Int
ft_LOAD_TARGET_LCD_V  = Int
262144

ft_RENDER_MODE_NORMAL, {-ft_RENDER_MODE_LIGHT,-} ft_RENDER_MODE_MONO,
    ft_RENDER_MODE_LCD, ft_RENDER_MODE_LCD_V :: Int
ft_RENDER_MODE_NORMAL :: Int
ft_RENDER_MODE_NORMAL = Int
0
--ft_RENDER_MODE_LIGHT  = 1
ft_RENDER_MODE_MONO :: Int
ft_RENDER_MODE_MONO   = Int
2
ft_RENDER_MODE_LCD :: Int
ft_RENDER_MODE_LCD    = Int
3
ft_RENDER_MODE_LCD_V :: Int
ft_RENDER_MODE_LCD_V  = Int
4