{-# LANGUAGE DeriveGeneric #-}
module Data.Text.Glyphize.Font where

import Data.ByteString.Internal (ByteString(..))
import Data.ByteString (packCStringLen)
import Data.Word (Word8, Word32)
import Data.Int (Int32)
import FreeType.Core.Base (FT_Face)
import Data.Text.Glyphize.Buffer (tag_to_string, tag_from_string, Direction, dir2int,
                                c2w, w2c)
import Data.Text.Glyphize.Oom (throwNull, throwFalse)

import Control.Monad (forM, unless)
import Control.Exception (bracket)
import Data.Maybe (fromMaybe)

import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO)
import Foreign.ForeignPtr (ForeignPtr(..), withForeignPtr, newForeignPtr, newForeignPtr_)
import Foreign.Ptr (Ptr(..), FunPtr(..), nullPtr, nullFunPtr, castPtr)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Marshal.Array (withArray, withArrayLen, peekArray)
import Foreign.Storable (Storable(..))
import Foreign.Storable.Generic (GStorable(..))
import GHC.Generics (Generic(..))
import Foreign.C.String (CString, withCString, withCStringLen, peekCString, peekCStringLen)

------
--- Features & Variants
------

-- | The structure that holds information about requested feature application.
-- The feature will be applied with the given value to all glyphs which are
-- in clusters between start (inclusive) and end (exclusive).
-- Setting start to HB_FEATURE_GLOBAL_START and end to HB_FEATURE_GLOBAL_END specifies
-- that the feature always applies to the entire buffer.
data Feature = Feature {
    Feature -> Word32
featTag' :: Word32,
    -- ^ Tag of the feature. Use `featTag` to decode as an ASCII string.
    Feature -> Word32
featValue :: Word32,
    -- ^ The value of the feature.
    -- 0 disables the feature, non-zero (usually 1) enables the feature.
    -- For features implemented as lookup type 3 (like "salt") the value
    -- is a one based index into the alternates.
    Feature -> Word
featStart :: Word,
    -- ^ The cluster to start applying this feature setting (inclusive).
    Feature -> Word
featEnd :: Word
    -- ^ The cluster to end applying this feature setting (exclusive).
} deriving (ReadPrec [Feature]
ReadPrec Feature
Int -> ReadS Feature
ReadS [Feature]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Feature]
$creadListPrec :: ReadPrec [Feature]
readPrec :: ReadPrec Feature
$creadPrec :: ReadPrec Feature
readList :: ReadS [Feature]
$creadList :: ReadS [Feature]
readsPrec :: Int -> ReadS Feature
$creadsPrec :: Int -> ReadS Feature
Read, Int -> Feature -> ShowS
[Feature] -> ShowS
Feature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feature] -> ShowS
$cshowList :: [Feature] -> ShowS
show :: Feature -> String
$cshow :: Feature -> String
showsPrec :: Int -> Feature -> ShowS
$cshowsPrec :: Int -> Feature -> ShowS
Show, forall x. Rep Feature x -> Feature
forall x. Feature -> Rep Feature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Feature x -> Feature
$cfrom :: forall x. Feature -> Rep Feature x
Generic, Eq Feature
Feature -> Feature -> Bool
Feature -> Feature -> Ordering
Feature -> Feature -> Feature
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Feature -> Feature -> Feature
$cmin :: Feature -> Feature -> Feature
max :: Feature -> Feature -> Feature
$cmax :: Feature -> Feature -> Feature
>= :: Feature -> Feature -> Bool
$c>= :: Feature -> Feature -> Bool
> :: Feature -> Feature -> Bool
$c> :: Feature -> Feature -> Bool
<= :: Feature -> Feature -> Bool
$c<= :: Feature -> Feature -> Bool
< :: Feature -> Feature -> Bool
$c< :: Feature -> Feature -> Bool
compare :: Feature -> Feature -> Ordering
$ccompare :: Feature -> Feature -> Ordering
Ord, Feature -> Feature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Feature -> Feature -> Bool
$c/= :: Feature -> Feature -> Bool
== :: Feature -> Feature -> Bool
$c== :: Feature -> Feature -> Bool
Eq)
instance GStorable Feature
-- | Parses a string into a hb_feature_t.
-- The format for specifying feature strings follows. All valid CSS
-- font-feature-settings values other than "normal" and the global values
-- are also accepted. CSS string escapes are not supported.
-- See https://harfbuzz.github.io/harfbuzz-hb-common.html#hb-feature-from-string
-- for additional details.
-- The range indices refer to the positions between Unicode characters.
-- The position before the first character is always 0.
parseFeature :: String -> Maybe Feature
parseFeature :: String -> Maybe Feature
parseFeature String
str = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
str', Int
len) -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Feature
ret' -> do
    Bool
success <- Ptr CChar -> Int -> Ptr Feature -> IO Bool
hb_feature_from_string Ptr CChar
str' Int
len Ptr Feature
ret'
    if Bool
success then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr Feature
ret' else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
parseFeature' :: String -> Feature
parseFeature' String
str = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
str', Int
len) -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Feature
ret' -> do
    IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Ptr CChar -> Int -> Ptr Feature -> IO Bool
hb_feature_from_string Ptr CChar
str' Int
len Ptr Feature
ret'
    forall a. Storable a => Ptr a -> IO a
peek Ptr Feature
ret'
foreign import ccall "hb_feature_from_string" hb_feature_from_string
    :: CString -> Int -> Ptr Feature -> IO Bool
-- | Converts a `Feature` into a `String` in the format understood by `parseFeature`.
unparseFeature :: Feature -> String
unparseFeature :: Feature -> String
unparseFeature Feature
feature = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Feature
feature' -> forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
128 forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ret' -> do
    Ptr Feature
feature' forall a. Storable a => Ptr a -> a -> IO ()
`poke` Feature
feature
    Ptr Feature -> Ptr CChar -> Word -> IO ()
hb_feature_to_string Ptr Feature
feature' Ptr CChar
ret' Word
128
    Ptr CChar -> IO String
peekCString Ptr CChar
ret'
foreign import ccall "hb_feature_to_string" hb_feature_to_string
    :: Ptr Feature -> CString -> Word -> IO ()

-- | Data type for holding variation data.
-- Registered OpenType variation-axis tags are listed in
-- [OpenType Axis Tag Registry](https://docs.microsoft.com/en-us/typography/opentype/spec/dvaraxisreg).
data Variation = Variation {
    Variation -> Word32
varTag' :: Word32,
    -- ^ Tag of the variation-axis name. Use `varTag` to decode as an ASCII string.
    Variation -> Float
varValue :: Float
    -- ^ Value of the variation axis.
} deriving (ReadPrec [Variation]
ReadPrec Variation
Int -> ReadS Variation
ReadS [Variation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Variation]
$creadListPrec :: ReadPrec [Variation]
readPrec :: ReadPrec Variation
$creadPrec :: ReadPrec Variation
readList :: ReadS [Variation]
$creadList :: ReadS [Variation]
readsPrec :: Int -> ReadS Variation
$creadsPrec :: Int -> ReadS Variation
Read, Int -> Variation -> ShowS
[Variation] -> ShowS
Variation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Variation] -> ShowS
$cshowList :: [Variation] -> ShowS
show :: Variation -> String
$cshow :: Variation -> String
showsPrec :: Int -> Variation -> ShowS
$cshowsPrec :: Int -> Variation -> ShowS
Show, forall x. Rep Variation x -> Variation
forall x. Variation -> Rep Variation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Variation x -> Variation
$cfrom :: forall x. Variation -> Rep Variation x
Generic, Eq Variation
Variation -> Variation -> Bool
Variation -> Variation -> Ordering
Variation -> Variation -> Variation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Variation -> Variation -> Variation
$cmin :: Variation -> Variation -> Variation
max :: Variation -> Variation -> Variation
$cmax :: Variation -> Variation -> Variation
>= :: Variation -> Variation -> Bool
$c>= :: Variation -> Variation -> Bool
> :: Variation -> Variation -> Bool
$c> :: Variation -> Variation -> Bool
<= :: Variation -> Variation -> Bool
$c<= :: Variation -> Variation -> Bool
< :: Variation -> Variation -> Bool
$c< :: Variation -> Variation -> Bool
compare :: Variation -> Variation -> Ordering
$ccompare :: Variation -> Variation -> Ordering
Ord, Variation -> Variation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Variation -> Variation -> Bool
$c/= :: Variation -> Variation -> Bool
== :: Variation -> Variation -> Bool
$c== :: Variation -> Variation -> Bool
Eq)
instance GStorable Variation
-- | Parses a string into a hb_variation_t.
-- The format for specifying variation settings follows.
-- All valid CSS font-variation-settings values other than "normal" and "inherited"
-- are also accepted, though, not documented below.
-- The format is a tag, optionally followed by an equals sign, followed by a number.
-- For example wght=500, or slnt=-7.5.
parseVariation :: String -> Maybe Variation
parseVariation :: String -> Maybe Variation
parseVariation String
str = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
str', Int
len) -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Variation
ret' -> do
    Bool
success <- Ptr CChar -> Int -> Ptr Variation -> IO Bool
hb_variation_from_string Ptr CChar
str' Int
len Ptr Variation
ret'
    if Bool
success then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr Variation
ret' else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
parseVariation' :: String -> Variation
parseVariation' String
str = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
str', Int
len) -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Variation
ret' -> do
    IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Ptr CChar -> Int -> Ptr Variation -> IO Bool
hb_variation_from_string Ptr CChar
str' Int
len Ptr Variation
ret'
    forall a. Storable a => Ptr a -> IO a
peek Ptr Variation
ret'
foreign import ccall "hb_variation_from_string" hb_variation_from_string
    :: CString -> Int -> Ptr Variation -> IO Bool
-- | Converts a `Variation` into a `String` in the format understood by `parseVariation`.
unparseVariation :: Variation -> String
unparseVariation Variation
var = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Variation
var' -> forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
128 forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ret' -> do
    Ptr Variation
var' forall a. Storable a => Ptr a -> a -> IO ()
`poke` Variation
var
    Ptr Variation -> Ptr CChar -> Word -> IO ()
hb_variation_to_string Ptr Variation
var' Ptr CChar
ret' Word
128
    Ptr CChar -> IO String
peekCString Ptr CChar
ret'
foreign import ccall "hb_variation_to_string" hb_variation_to_string
    :: Ptr Variation -> CString -> Word -> IO ()

-- | Tag of the feature.
featTag :: Feature -> String
featTag = Word32 -> String
tag_to_string forall b c a. (b -> c) -> (a -> b) -> a -> c
. Feature -> Word32
featTag'
-- | Tag of the variation-axis.
varTag :: Variation -> String
varTag = Word32 -> String
tag_to_string forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variation -> Word32
varTag'
globalStart, globalEnd :: Word
-- | Special setting for `featStart` to apply the feature from the start of the buffer.
globalStart :: Word
globalStart = Word
0
-- | Special setting for `featEnd` to apply the feature to the end of the buffer.
globalEnd :: Word
globalEnd = forall a. Bounded a => a
maxBound

------
--- Faces
------

-- | Fetches the number of `Face`s in a `ByteString`.
countFace :: ByteString -> Word
countFace :: ByteString -> Word
countFace ByteString
bytes = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (Blob_ -> IO a) -> IO a
withBlob ByteString
bytes Blob_ -> IO Word
hb_face_count
foreign import ccall "hb_face_count" hb_face_count :: Blob_ -> IO Word

-- | A Font face.
type Face = ForeignPtr Face'
type Face_ = Ptr Face'
data Face'
-- | Constructs a new face object from the specified blob and a face index into that blob.
-- The face index is used for blobs of file formats such as TTC and and DFont that
-- can contain more than one face. Face indices within such collections are zero-based.
-- Note: If the blob font format is not a collection, index is ignored. Otherwise,
-- only the lower 16-bits of index are used. The unmodified index can be accessed
-- via `faceIndex`.
-- Note: The high 16-bits of index, if non-zero, are used by `createFont` to
-- load named-instances in variable fonts. See `createFont` for details.
createFace :: ByteString -> Word -> Face
createFace :: ByteString -> Word -> Face
createFace ByteString
bytes Word
index = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Ptr Face'
face <- forall a. ByteString -> (Blob_ -> IO a) -> IO a
withBlob ByteString
bytes forall a b. (a -> b) -> a -> b
$ forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Blob_ -> Word -> IO (Ptr Face')
hb_face_create Word
index
    Ptr Face' -> IO ()
hb_face_make_immutable Ptr Face'
face
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Face' -> IO ())
hb_face_destroy Ptr Face'
face
foreign import ccall "hb_face_create" hb_face_create :: Blob_ -> Word -> IO Face_
foreign import ccall "hb_face_make_immutable" hb_face_make_immutable :: Face_ -> IO ()
foreign import ccall "&hb_face_destroy" hb_face_destroy :: FunPtr (Face_ -> IO ())

-- | Creates a`Face` object from the specified `FT_Face`.
-- Not thread-safe due to FreeType dependency.
ftCreateFace :: FT_Face -> IO Face
ftCreateFace :: FT_Face -> IO Face
ftCreateFace FT_Face
ft = do
    Ptr Face'
ret <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ FT_Face -> IO (Ptr Face')
hb_ft_face_create_referenced FT_Face
ft
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Face' -> IO ())
hb_face_destroy Ptr Face'
ret
foreign import ccall "hb_ft_face_create_referenced" hb_ft_face_create_referenced
    :: FT_Face -> IO Face_

-- | Fetches the singleton empty `Face` object.
emptyFace :: Face
emptyFace :: Face
emptyFace = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Face' -> IO ())
hb_face_destroy Ptr Face'
hb_face_get_empty
foreign import ccall "hb_face_get_empty" hb_face_get_empty :: Face_

-- | Fetches a list of all table tags for a face, if possible.
-- The list returned will begin at the offset provided
faceTableTags :: Face -> Word -> Word -> (Word, [String])
faceTableTags :: Face -> Word -> Word -> (Word, [String])
faceTableTags Face
fce Word
offs Word
cnt = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
fce forall a b. (a -> b) -> a -> b
$ \Ptr Face'
fce' -> do
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word
cnt' -> forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (forall a. Enum a => a -> Int
fromEnum Word
cnt forall a. Num a => a -> a -> a
* Int
4) forall a b. (a -> b) -> a -> b
$ \Ptr Word32
arr' -> do
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word
cnt' Word
cnt
        Word
length <- Ptr Face' -> Word -> Ptr Word -> Ptr Word32 -> IO Word
hb_face_get_table_tags Ptr Face'
fce' Word
offs Ptr Word
cnt' Ptr Word32
arr'
        Word
cnt_ <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word
cnt'
        [Word32]
arr <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..forall a. Enum a => a -> Int
fromEnum Word
cnt_forall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word32
arr'
        forall (m :: * -> *) a. Monad m => a -> m a
return (Word
length, forall a b. (a -> b) -> [a] -> [b]
Prelude.map Word32 -> String
tag_to_string [Word32]
arr)
foreign import ccall "hb_face_get_table_tags" hb_face_get_table_tags
    :: Face_ -> Word -> Ptr Word -> Ptr Word32 -> IO Word

-- | Fetches the glyph-count value of the specified face object.
faceGlyphCount :: Face -> Word
faceGlyphCount :: Face -> Word
faceGlyphCount = forall a. (Ptr Face' -> a) -> Face -> a
faceFunc Ptr Face' -> Word
hb_face_get_glyph_count
foreign import ccall "hb_face_get_glyph_count" hb_face_get_glyph_count :: Face_ -> Word

-- | Collects all of the Unicode characters covered by `Face` into a list of unique values.
faceCollectUnicodes :: Face -> [Word32]
faceCollectUnicodes :: Face -> [Word32]
faceCollectUnicodes = (Ptr Face' -> Set_ -> IO ()) -> Face -> [Word32]
faceCollectFunc Ptr Face' -> Set_ -> IO ()
hb_face_collect_unicodes
foreign import ccall "hb_face_collect_unicodes" hb_face_collect_unicodes
    :: Face_ -> Set_ -> IO ()

-- | Collects all Unicode "Variation Selector" characters covered by `Face`
-- into a list of unique values.
faceCollectVarSels :: Face -> [Word32]
faceCollectVarSels :: Face -> [Word32]
faceCollectVarSels = (Ptr Face' -> Set_ -> IO ()) -> Face -> [Word32]
faceCollectFunc Ptr Face' -> Set_ -> IO ()
hb_face_collect_variation_selectors
foreign import ccall "hb_face_collect_variation_selectors"
    hb_face_collect_variation_selectors :: Face_ -> Set_ -> IO ()

-- | Collects all Unicode characters for variation_selector covered by `Face`
-- into a list of unique values.
faceCollectVarUnicodes :: Face -> Word32 -> [Word32]
faceCollectVarUnicodes :: Face -> Word32 -> [Word32]
faceCollectVarUnicodes Face
fce Word32
varSel = ((Ptr Face' -> Set_ -> IO ()) -> Face -> [Word32]
faceCollectFunc Ptr Face' -> Set_ -> IO ()
inner) Face
fce
  where inner :: Ptr Face' -> Set_ -> IO ()
inner Ptr Face'
a Set_
b = Ptr Face' -> Word32 -> Set_ -> IO ()
hb_face_collect_variation_unicodes Ptr Face'
a Word32
varSel Set_
b
foreign import ccall "hb_face_collect_variation_unicodes"
    hb_face_collect_variation_unicodes :: Face_ -> Word32 -> Set_ -> IO ()

-- | Fetches the face-index corresponding to the given `Face`.
faceIndex :: Face -> Word
faceIndex :: Face -> Word
faceIndex = forall a. (Ptr Face' -> a) -> Face -> a
faceFunc Ptr Face' -> Word
hb_face_get_index
foreign import ccall "hb_face_get_index" hb_face_get_index :: Face_ -> Word

-- | Fetches the units-per-em (upem) value of the specified `Face` object.
faceUpem :: Face -> Word
faceUpem :: Face -> Word
faceUpem = forall a. (Ptr Face' -> a) -> Face -> a
faceFunc Ptr Face' -> Word
hb_face_get_upem
foreign import ccall "hb_face_get_upem" hb_face_get_upem :: Face_ -> Word

-- | Fetches the binary blob that contains the specified `Face`.
-- Returns an empty `ByteString` if referencing face data is not possible.
faceBlob :: Face -> ByteString
faceBlob :: Face -> ByteString
faceBlob = Blob_ -> ByteString
blob2bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Ptr Face' -> a) -> Face -> a
faceFunc Ptr Face' -> Blob_
hb_face_reference_blob
foreign import ccall "hb_face_reference_blob" hb_face_reference_blob :: Face_ -> Blob_

-- | Fetches the specified table within the specified face.
faceTable :: Face -> String -> ByteString
faceTable :: Face -> String -> ByteString
faceTable Face
face String
tag = Blob_ -> ByteString
blob2bs forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
face forall a b. (a -> b) -> a -> b
$ \Ptr Face'
fce' -> do
    Ptr Face' -> Word32 -> IO Blob_
hb_face_reference_table Ptr Face'
fce' forall a b. (a -> b) -> a -> b
$ String -> Word32
tag_from_string String
tag
foreign import ccall "hb_face_reference_table" hb_face_reference_table :: Face_ -> Word32 -> IO Blob_

------
--- Configure faces
------

-- | Allows configuring properties on a `Face` when creating it.
data FaceOptions = FaceOptions {
    FaceOptions -> Maybe Int
faceOptGlyphCount :: Maybe Int,
    -- ^ Sets the glyph count for a newly-created `Face` to the specified value.
    FaceOptions -> Maybe Word
faceOptIndex :: Maybe Word,
    -- ^ Assigns the specified face-index to the newly-created `Face`.
    -- Note: changing the index has no effect on the face itself,
    -- only value returned by `faceIndex`.
    FaceOptions -> Maybe Word
faceOptUPEm :: Maybe Word
    -- ^ Sets the units-per-em (upem) for a newly-created `Face` object
    -- to the specified value.
} deriving (ReadPrec [FaceOptions]
ReadPrec FaceOptions
Int -> ReadS FaceOptions
ReadS [FaceOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FaceOptions]
$creadListPrec :: ReadPrec [FaceOptions]
readPrec :: ReadPrec FaceOptions
$creadPrec :: ReadPrec FaceOptions
readList :: ReadS [FaceOptions]
$creadList :: ReadS [FaceOptions]
readsPrec :: Int -> ReadS FaceOptions
$creadsPrec :: Int -> ReadS FaceOptions
Read, Int -> FaceOptions -> ShowS
[FaceOptions] -> ShowS
FaceOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FaceOptions] -> ShowS
$cshowList :: [FaceOptions] -> ShowS
show :: FaceOptions -> String
$cshow :: FaceOptions -> String
showsPrec :: Int -> FaceOptions -> ShowS
$cshowsPrec :: Int -> FaceOptions -> ShowS
Show, Eq FaceOptions
FaceOptions -> FaceOptions -> Bool
FaceOptions -> FaceOptions -> Ordering
FaceOptions -> FaceOptions -> FaceOptions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FaceOptions -> FaceOptions -> FaceOptions
$cmin :: FaceOptions -> FaceOptions -> FaceOptions
max :: FaceOptions -> FaceOptions -> FaceOptions
$cmax :: FaceOptions -> FaceOptions -> FaceOptions
>= :: FaceOptions -> FaceOptions -> Bool
$c>= :: FaceOptions -> FaceOptions -> Bool
> :: FaceOptions -> FaceOptions -> Bool
$c> :: FaceOptions -> FaceOptions -> Bool
<= :: FaceOptions -> FaceOptions -> Bool
$c<= :: FaceOptions -> FaceOptions -> Bool
< :: FaceOptions -> FaceOptions -> Bool
$c< :: FaceOptions -> FaceOptions -> Bool
compare :: FaceOptions -> FaceOptions -> Ordering
$ccompare :: FaceOptions -> FaceOptions -> Ordering
Ord, FaceOptions -> FaceOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FaceOptions -> FaceOptions -> Bool
$c/= :: FaceOptions -> FaceOptions -> Bool
== :: FaceOptions -> FaceOptions -> Bool
$c== :: FaceOptions -> FaceOptions -> Bool
Eq)
-- | `FaceOptions` which has no effect on the newly-created `Face` object.
defaultFaceOptions :: FaceOptions
defaultFaceOptions = Maybe Int -> Maybe Word -> Maybe Word -> FaceOptions
FaceOptions forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
-- | Internal utility to apply the given `FaceOptions` to a `Face`.
_setFaceOptions :: Ptr Face' -> FaceOptions -> IO ()
_setFaceOptions Ptr Face'
face FaceOptions
opts = do
    case FaceOptions -> Maybe Int
faceOptGlyphCount FaceOptions
opts of
        Just Int
x -> Ptr Face' -> Int -> IO ()
hb_face_set_glyph_count Ptr Face'
face Int
x
        Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case FaceOptions -> Maybe Word
faceOptIndex FaceOptions
opts of
        Just Word
x -> Ptr Face' -> Word -> IO ()
hb_face_set_index Ptr Face'
face Word
x
        Maybe Word
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case FaceOptions -> Maybe Word
faceOptUPEm FaceOptions
opts of
        Just Word
x -> Ptr Face' -> Word -> IO ()
hb_face_set_upem Ptr Face'
face Word
x
        Maybe Word
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall "hb_face_set_glyph_count" hb_face_set_glyph_count
    :: Face_ -> Int -> IO ()
foreign import ccall "hb_face_set_index" hb_face_set_index :: Face_ -> Word -> IO ()
foreign import ccall "hb_face_set_upem" hb_face_set_upem :: Face_ -> Word -> IO ()

-- | Variant of `createFace` which applies given options.
createFaceWithOpts  :: FaceOptions -> ByteString -> Word -> Face
createFaceWithOpts :: FaceOptions -> ByteString -> Word -> Face
createFaceWithOpts FaceOptions
opts ByteString
bytes Word
index = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Ptr Face'
face <- forall a. ByteString -> (Blob_ -> IO a) -> IO a
withBlob ByteString
bytes forall a b. (a -> b) -> a -> b
$ forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Blob_ -> Word -> IO (Ptr Face')
hb_face_create Word
index
    Ptr Face' -> FaceOptions -> IO ()
_setFaceOptions Ptr Face'
face FaceOptions
opts
    Ptr Face' -> IO ()
hb_face_make_immutable Ptr Face'
face
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Face' -> IO ())
hb_face_destroy Ptr Face'
face
-- | Variant of `ftCreateFace` which applies given options.
ftCreateFaceWithOpts :: FaceOptions -> FT_Face -> IO Face
ftCreateFaceWithOpts :: FaceOptions -> FT_Face -> IO Face
ftCreateFaceWithOpts FaceOptions
opts FT_Face
ftFace = do
    Ptr Face'
face <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ FT_Face -> IO (Ptr Face')
hb_ft_face_create_referenced FT_Face
ftFace
    Ptr Face' -> FaceOptions -> IO ()
_setFaceOptions Ptr Face'
face FaceOptions
opts
    Ptr Face' -> IO ()
hb_face_make_immutable Ptr Face'
face
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Face' -> IO ())
hb_face_destroy Ptr Face'
face

-- | Creates a `Face` containing the specified tables+tags, with the specified options.
-- Can be compiled to a binary font file by calling `faceBlob`,
-- with tables sorted by size then tag.
buildFace :: [(String, ByteString)] -> FaceOptions -> Face
buildFace :: [(String, ByteString)] -> FaceOptions -> Face
buildFace [(String, ByteString)]
tables FaceOptions
opts = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Ptr Face'
builder <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull IO (Ptr Face')
hb_face_builder_create
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, ByteString)]
tables forall a b. (a -> b) -> a -> b
$ \(String
tag, ByteString
bytes) ->
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (Blob_ -> IO a) -> IO a
withBlob ByteString
bytes forall a b. (a -> b) -> a -> b
$
            Ptr Face' -> Word32 -> Blob_ -> IO Bool
hb_face_builder_add_table Ptr Face'
builder forall a b. (a -> b) -> a -> b
$ String -> Word32
tag_from_string String
tag
    Ptr Face' -> FaceOptions -> IO ()
_setFaceOptions Ptr Face'
builder FaceOptions
opts
    Ptr Face' -> IO ()
hb_face_make_immutable Ptr Face'
builder
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Face' -> IO ())
hb_face_destroy Ptr Face'
builder
foreign import ccall "hb_face_builder_create" hb_face_builder_create :: IO Face_
foreign import ccall "hb_face_builder_add_table" hb_face_builder_add_table
    :: Face_ -> Word32 -> Blob_ -> IO Bool
{-
-- | Creates a `Face` containing the specified tables+tags, with the specified options.
-- Can be compiled to a binary font file by calling `faceBlob`,
-- with tables in the given order.
buildOrderedFace :: [(String, ByteString)] -> FaceOptions -> Face
buildOrderedFace tables opts = unsafePerformIO $ do
    builder <- hb_face_builder_create
    forM tables $ \(tag, bytes) -> do
        blob <- bs2blob bytes
        withForeignPtr blob $ hb_face_builder_add_table builder $ tag_from_string tag
    withArray (map tag_from_string $ map fst tables) $ hb_face_builder_sort_tables builder
    _setFaceOptions builder opts
    hb_face_make_immutable builder
    newForeignPtr hb_face_destroy builder
foreign import ccall "hb_face_builder_sort_tables" hb_face_builder_sort_tables
    :: Face_ -> Ptr Word32 -> IO ()-}

------
--- Fonts
------

-- | Data type for holding fonts
type Font = ForeignPtr Font'
type Font_ = Ptr Font'
data Font'

-- | Constructs a new `Font` object from the specified `Face`.
-- Note: If face's index value (as passed to `createFace` has non-zero top 16-bits,
-- those bits minus one are passed to hb_font_set_var_named_instance(),
-- effectively loading a named-instance of a variable font,
-- instead of the default-instance.
-- This allows specifying which named-instance to load by default when creating the face.
createFont :: Face -> Font
createFont :: Face -> Font
createFont Face
fce = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Ptr Font'
font <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
fce forall a b. (a -> b) -> a -> b
$ Ptr Face' -> IO (Ptr Font')
hb_font_create
    Ptr Font' -> IO ()
hb_font_make_immutable Ptr Font'
font
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Font' -> IO ())
hb_font_destroy Ptr Font'
font
foreign import ccall "hb_font_create" hb_font_create :: Face_ -> IO Font_
foreign import ccall "hb_font_make_immutable" hb_font_make_immutable :: Font_ -> IO ()
foreign import ccall "&hb_font_destroy" hb_font_destroy :: FunPtr (Font_ -> IO ())

-- | Creates an `Font` object from the specified FT_Face.
-- Note: You must set the face size on ft_face before calling `ftCreateFont` on it.
-- HarfBuzz assumes size is always set
-- and will access `frSize`` member of `FT_Face` unconditionally.
ftCreateFont :: FT_Face -> IO Font
ftCreateFont :: FT_Face -> IO Font
ftCreateFont FT_Face
fce = do
    Ptr Font'
font <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ FT_Face -> IO (Ptr Font')
hb_ft_font_create_referenced FT_Face
fce
    Ptr Font' -> IO ()
hb_font_make_immutable Ptr Font'
font
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Font' -> IO ())
hb_font_destroy Ptr Font'
font
foreign import ccall "hb_ft_font_create_referenced" hb_ft_font_create_referenced
    :: FT_Face -> IO Font_

-- | Constructs a sub-font font object from the specified parent font,
-- replicating the parent's properties.
createSubFont :: Font -> Font
createSubFont :: Font -> Font
createSubFont Font
parent = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Ptr Font'
font <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
parent forall a b. (a -> b) -> a -> b
$ Ptr Font' -> IO (Ptr Font')
hb_font_create_sub_font
    Ptr Font' -> IO ()
hb_font_make_immutable Ptr Font'
font
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Font' -> IO ())
hb_font_destroy Ptr Font'
font
foreign import ccall "hb_font_create_sub_font" hb_font_create_sub_font :: Font_ -> IO Font_

-- | Fetches the empty `Font` object.
emptyFont :: Font
emptyFont :: Font
emptyFont = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Font' -> IO ())
hb_font_destroy Ptr Font'
hb_font_get_empty
foreign import ccall "hb_font_get_empty" hb_font_get_empty :: Font_

-- | Fetches the `Face` associated with the specified `Font` object.
fontFace :: Font -> Face
fontFace :: Font -> Face
fontFace Font
font = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> do
    Ptr Face'
face' <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ Ptr Font' -> IO (Ptr Face')
hb_font_get_face Ptr Font'
font'
    forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Face'
face' -- FIXME: Keep the font alive...
foreign import ccall "hb_font_get_face" hb_font_get_face :: Font_ -> IO Face_
 
-- | Fetches the glyph ID for a Unicode codepoint in the specified `Font`,
-- with an optional variation selector.
fontGlyph :: Font -> Char -> Maybe Char -> Maybe Word32
fontGlyph :: Font -> Char -> Maybe Char -> Maybe Word32
fontGlyph Font
font Char
char Maybe Char
var =
    forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
ret -> do
        Bool
success <- Ptr Font' -> Word32 -> Word32 -> Ptr Word32 -> IO Bool
hb_font_get_glyph Ptr Font'
font' (Char -> Word32
c2w Char
char) (Char -> Word32
c2w forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Char
'\0' Maybe Char
var) Ptr Word32
ret
        if Bool
success then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
ret else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontGlyph' :: Font -> Char -> Maybe Char -> Word32
fontGlyph' Font
font Char
char Maybe Char
var =
    forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
ret -> do
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Word32 -> Word32 -> Ptr Word32 -> IO Bool
hb_font_get_glyph Ptr Font'
font' (Char -> Word32
c2w Char
char) (Char -> Word32
c2w forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Char
'\0' Maybe Char
var) Ptr Word32
ret
        forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
ret
foreign import ccall "hb_font_get_glyph" hb_font_get_glyph
    :: Font_ -> Word32 -> Word32 -> Ptr Word32 -> IO Bool

-- | Fetches the advance for a glyph ID from the specified font,
-- in a text segment of the specified direction.
-- Calls the appropriate direction-specific variant (horizontal or vertical)
-- depending on the value of direction .
fontGlyphAdvance :: Font -> Word32 -> Maybe Direction -> (Int32, Int32)
fontGlyphAdvance :: Font -> Word32 -> Maybe Direction -> (Int32, Int32)
fontGlyphAdvance Font
font Word32
glyph Maybe Direction
dir = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
y' -> do
        Ptr Font' -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO ()
hb_font_get_glyph_advance_for_direction Ptr Font'
font' Word32
glyph (forall {a}. Num a => Maybe Direction -> a
dir2int Maybe Direction
dir) Ptr Int32
x' Ptr Int32
y'
        Int32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
        Int32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
x, Int32
y)
foreign import ccall "hb_font_get_glyph_advance_for_direction"
    hb_font_get_glyph_advance_for_direction
        :: Font_ -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO ()

-- | Fetches the (x,y) coordinates of a specified contour-point index
-- in the specified glyph, within the specified font.
fontGlyphContourPoint :: Font -> Word32 -> Int -> Maybe (Int32, Int32)
fontGlyphContourPoint :: Font -> Word32 -> Int -> Maybe (Int32, Int32)
fontGlyphContourPoint Font
font Word32
glyph Int
index = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
y' -> do
        Bool
success <- Ptr Font' -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO Bool
hb_font_get_glyph_contour_point Ptr Font'
font' Word32
glyph Int
index Ptr Int32
x' Ptr Int32
y'
        if Bool
success
        then do
            Int32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
            Int32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int32
x, Int32
y)
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontGlyphContourPoint' :: Font -> Word32 -> Int -> (Int32, Int32)
fontGlyphContourPoint' Font
font Word32
glyph Int
index = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
y' -> do
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO Bool
hb_font_get_glyph_contour_point Ptr Font'
font' Word32
glyph Int
index Ptr Int32
x' Ptr Int32
y'
        Int32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
        Int32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
x, Int32
y)
foreign import ccall "hb_font_get_glyph_contour_point" hb_font_get_glyph_contour_point
    :: Font_ -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO Bool

-- | Fetches the (X,Y) coordinates of a specified contour-point index
-- in the specified glyph ID in the specified font,
-- with respect to the origin in a text segment in the specified direction.
-- Calls the appropriate direction-specific variant (horizontal or vertical)
-- depending on the value of direction .
fontGlyphContourPointForOrigin :: Font -> Word32 -> Int -> Maybe Direction -> Maybe (Int32, Int32)
fontGlyphContourPointForOrigin :: Font -> Word32 -> Int -> Maybe Direction -> Maybe (Int32, Int32)
fontGlyphContourPointForOrigin Font
font Word32
glyph Int
index Maybe Direction
dir = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
y' -> do
        Bool
success <- Ptr Font'
-> Word32 -> Int -> Int -> Ptr Int32 -> Ptr Int32 -> IO Bool
hb_font_get_glyph_contour_point_for_origin Ptr Font'
font' Word32
glyph Int
index
                (forall {a}. Num a => Maybe Direction -> a
dir2int Maybe Direction
dir) Ptr Int32
x' Ptr Int32
y'
        if Bool
success
        then do
            Int32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
            Int32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int32
x, Int32
y)
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontGlyphContourPointForOrigin' :: Font -> Word32 -> Int -> Maybe Direction -> (Int32, Int32)
fontGlyphContourPointForOrigin' Font
font Word32
glyph Int
index Maybe Direction
dir = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
y' -> do
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Ptr Font'
-> Word32 -> Int -> Int -> Ptr Int32 -> Ptr Int32 -> IO Bool
hb_font_get_glyph_contour_point_for_origin Ptr Font'
font' Word32
glyph Int
index
                (forall {a}. Num a => Maybe Direction -> a
dir2int Maybe Direction
dir) Ptr Int32
x' Ptr Int32
y'
        Int32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
        Int32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
x, Int32
y)
foreign import ccall "hb_font_get_glyph_contour_point_for_origin"
    hb_font_get_glyph_contour_point_for_origin
        :: Font_ -> Word32 -> Int -> Int -> Ptr Int32 -> Ptr Int32 -> IO Bool

-- | Glyph extent values, measured in font units.
-- Note that height is negative, in coordinate systems that grow up.
data GlyphExtents = GlyphExtents {
    GlyphExtents -> Word32
xBearing :: Word32,
    -- ^ Distance from the x-origin to the left extremum of the glyph.
    GlyphExtents -> Word32
yBearing :: Word32,
    -- ^ Distance from the top extremum of the glyph to the y-origin.
    GlyphExtents -> Word32
width :: Word32,
    -- ^ Distance from the left extremum of the glyph to the right extremum.
    GlyphExtents -> Word32
height :: Word32
    -- ^ Distance from the top extremum of the glyph to the right extremum.
} deriving (forall x. Rep GlyphExtents x -> GlyphExtents
forall x. GlyphExtents -> Rep GlyphExtents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlyphExtents x -> GlyphExtents
$cfrom :: forall x. GlyphExtents -> Rep GlyphExtents x
Generic, ReadPrec [GlyphExtents]
ReadPrec GlyphExtents
Int -> ReadS GlyphExtents
ReadS [GlyphExtents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GlyphExtents]
$creadListPrec :: ReadPrec [GlyphExtents]
readPrec :: ReadPrec GlyphExtents
$creadPrec :: ReadPrec GlyphExtents
readList :: ReadS [GlyphExtents]
$creadList :: ReadS [GlyphExtents]
readsPrec :: Int -> ReadS GlyphExtents
$creadsPrec :: Int -> ReadS GlyphExtents
Read, Int -> GlyphExtents -> ShowS
[GlyphExtents] -> ShowS
GlyphExtents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphExtents] -> ShowS
$cshowList :: [GlyphExtents] -> ShowS
show :: GlyphExtents -> String
$cshow :: GlyphExtents -> String
showsPrec :: Int -> GlyphExtents -> ShowS
$cshowsPrec :: Int -> GlyphExtents -> ShowS
Show, Eq GlyphExtents
GlyphExtents -> GlyphExtents -> Bool
GlyphExtents -> GlyphExtents -> Ordering
GlyphExtents -> GlyphExtents -> GlyphExtents
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GlyphExtents -> GlyphExtents -> GlyphExtents
$cmin :: GlyphExtents -> GlyphExtents -> GlyphExtents
max :: GlyphExtents -> GlyphExtents -> GlyphExtents
$cmax :: GlyphExtents -> GlyphExtents -> GlyphExtents
>= :: GlyphExtents -> GlyphExtents -> Bool
$c>= :: GlyphExtents -> GlyphExtents -> Bool
> :: GlyphExtents -> GlyphExtents -> Bool
$c> :: GlyphExtents -> GlyphExtents -> Bool
<= :: GlyphExtents -> GlyphExtents -> Bool
$c<= :: GlyphExtents -> GlyphExtents -> Bool
< :: GlyphExtents -> GlyphExtents -> Bool
$c< :: GlyphExtents -> GlyphExtents -> Bool
compare :: GlyphExtents -> GlyphExtents -> Ordering
$ccompare :: GlyphExtents -> GlyphExtents -> Ordering
Ord, GlyphExtents -> GlyphExtents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphExtents -> GlyphExtents -> Bool
$c/= :: GlyphExtents -> GlyphExtents -> Bool
== :: GlyphExtents -> GlyphExtents -> Bool
$c== :: GlyphExtents -> GlyphExtents -> Bool
Eq)
instance GStorable GlyphExtents
-- | Fetches the `GlyphExtents` data for a glyph ID in the specified `Font`.
fontGlyphExtents :: Font -> Word32 -> Maybe GlyphExtents
fontGlyphExtents :: Font -> Word32 -> Maybe GlyphExtents
fontGlyphExtents Font
font Word32
glyph = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GlyphExtents
ret -> do
        Bool
success <- Ptr Font' -> Word32 -> Ptr GlyphExtents -> IO Bool
hb_font_get_glyph_extents Ptr Font'
font' Word32
glyph Ptr GlyphExtents
ret
        if Bool
success
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr GlyphExtents
ret
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontGlyphExtents' :: Font -> Word32 -> GlyphExtents
fontGlyphExtents' Font
font Word32
glyph = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GlyphExtents
ret -> do
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Word32 -> Ptr GlyphExtents -> IO Bool
hb_font_get_glyph_extents Ptr Font'
font' Word32
glyph Ptr GlyphExtents
ret
        forall a. Storable a => Ptr a -> IO a
peek Ptr GlyphExtents
ret
foreign import ccall "hb_font_get_glyph_extents" hb_font_get_glyph_extents
    :: Font_ -> Word32 -> Ptr GlyphExtents -> IO Bool

-- | Fetches the `GlyphExtents` data for a glyph ID in the specified `Font`,
-- with respect to the origin in a text segment in the specified direction.
-- Calls the appropriate direction-specific variant (horizontal or vertical)
-- depending on the value of given `Direction`.
fontGlyphExtentsForOrigin :: Font -> Word32 -> Maybe Direction -> Maybe GlyphExtents
fontGlyphExtentsForOrigin :: Font -> Word32 -> Maybe Direction -> Maybe GlyphExtents
fontGlyphExtentsForOrigin Font
font Word32
glyph Maybe Direction
dir = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GlyphExtents
ret -> do
        Bool
ok <- Ptr Font' -> Word32 -> Int -> Ptr GlyphExtents -> IO Bool
hb_font_get_glyph_extents_for_origin Ptr Font'
font' Word32
glyph (forall {a}. Num a => Maybe Direction -> a
dir2int Maybe Direction
dir) Ptr GlyphExtents
ret
        if Bool
ok
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr GlyphExtents
ret
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontGlyphExtentsForOrigin' :: Font -> Word32 -> Maybe Direction -> GlyphExtents
fontGlyphExtentsForOrigin' Font
font Word32
glyph Maybe Direction
dir = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr GlyphExtents
ret -> do
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Word32 -> Int -> Ptr GlyphExtents -> IO Bool
hb_font_get_glyph_extents_for_origin Ptr Font'
font' Word32
glyph (forall {a}. Num a => Maybe Direction -> a
dir2int Maybe Direction
dir) Ptr GlyphExtents
ret
        forall a. Storable a => Ptr a -> IO a
peek Ptr GlyphExtents
ret
foreign import ccall "hb_font_get_glyph_extents_for_origin"
    hb_font_get_glyph_extents_for_origin
        :: Font_ -> Word32 -> Int -> Ptr GlyphExtents -> IO Bool

-- | Fetches the glyph ID that corresponds to a name string in the specified `Font`.
fontGlyphFromName :: Font -> String -> Maybe Word32
fontGlyphFromName :: Font -> String -> Maybe Word32
fontGlyphFromName Font
font String
name = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
ret -> do
        Bool
success <- forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
name forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
name', Int
len) ->
            Ptr Font' -> Ptr CChar -> Int -> Ptr Word32 -> IO Bool
hb_font_get_glyph_from_name Ptr Font'
font' Ptr CChar
name' Int
len Ptr Word32
ret
        if Bool
success
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
ret
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontGlyphFromName' :: Font -> String -> Word32
fontGlyphFromName' Font
font String
name = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
ret -> do
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
name forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
name', Int
len) ->
            Ptr Font' -> Ptr CChar -> Int -> Ptr Word32 -> IO Bool
hb_font_get_glyph_from_name Ptr Font'
font' Ptr CChar
name' Int
len Ptr Word32
ret
        forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
ret
foreign import ccall "hb_font_get_glyph_from_name" hb_font_get_glyph_from_name
    :: Font_ -> CString -> Int -> Ptr Word32 -> IO Bool

-- | Fetches the advance for a glyph ID in the specified `Font`,
-- for horizontal text segments.
fontGlyphHAdvance :: Font -> Word32 -> Int32
fontGlyphHAdvance :: Font -> Word32 -> Int32
fontGlyphHAdvance = forall a. (Ptr Font' -> a) -> Font -> a
fontFunc Ptr Font' -> Word32 -> Int32
hb_font_get_glyph_h_advance
foreign import ccall "hb_font_get_glyph_h_advance" hb_font_get_glyph_h_advance
    :: Font_ -> Word32 -> Int32

-- | Fetches the advance for a glyph ID in the specified `Font`,
-- for vertical text segments.
fontGlyphVAdvance :: Font -> Word32 -> Int32
fontGlyphVAdvance :: Font -> Word32 -> Int32
fontGlyphVAdvance = forall a. (Ptr Font' -> a) -> Font -> a
fontFunc Ptr Font' -> Word32 -> Int32
hb_font_get_glyph_v_advance
foreign import ccall "hb_font_get_glyph_v_advance" hb_font_get_glyph_v_advance
    :: Font_ -> Word32 -> Int32

-- | Fetches the kerning-adjustment value for a glyph-pair in the specified `Font`,
-- for horizontal text segments.
fontGlyphHKerning :: Font -> Word32 -> Word32 -> Int32
fontGlyphHKerning :: Font -> Word32 -> Word32 -> Int32
fontGlyphHKerning = forall a. (Ptr Font' -> a) -> Font -> a
fontFunc Ptr Font' -> Word32 -> Word32 -> Int32
hb_font_get_glyph_h_kerning
foreign import ccall "hb_font_get_glyph_h_kerning" hb_font_get_glyph_h_kerning
    :: Font_ -> Word32 -> Word32 -> Int32

-- | Fetches the (X,Y) coordinate of the origin for a glyph ID in the specified `Font`,
-- for horizontal text segments.
fontGlyphHOrigin :: Font -> Word32 -> Maybe (Int32, Int32)
fontGlyphHOrigin :: Font -> Word32 -> Maybe (Int32, Int32)
fontGlyphHOrigin Font
font Word32
glyph = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
y' -> do
        Bool
success <- Ptr Font' -> Word32 -> Ptr Int32 -> Ptr Int32 -> IO Bool
hb_font_get_glyph_h_origin Ptr Font'
font' Word32
glyph Ptr Int32
x' Ptr Int32
y'
        if Bool
success
        then do
            Int32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
            Int32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int32
x, Int32
y)
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontGlyphHOrigin' :: Font -> Word32 -> (Int32, Int32)
fontGlyphHOrigin' Font
font Word32
glyph = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
y' -> do
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Word32 -> Ptr Int32 -> Ptr Int32 -> IO Bool
hb_font_get_glyph_h_origin Ptr Font'
font' Word32
glyph Ptr Int32
x' Ptr Int32
y'
        Int32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
        Int32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
x, Int32
y)
foreign import ccall "hb_font_get_glyph_h_origin" hb_font_get_glyph_h_origin ::
    Font_ -> Word32 -> Ptr Int32 -> Ptr Int32 -> IO Bool

-- | Fetches the (X,Y) coordinates of the origin for a glyph ID in the specified `Font`,
-- for vertical text segments.
fontGlyphVOrigin :: Font -> Word32 -> Maybe (Int32, Int32)
fontGlyphVOrigin :: Font -> Word32 -> Maybe (Int32, Int32)
fontGlyphVOrigin Font
font Word32
glyph = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
y' -> do
        Bool
success <- Ptr Font' -> Word32 -> Ptr Int32 -> Ptr Int32 -> IO Bool
hb_font_get_glyph_v_origin Ptr Font'
font' Word32
glyph Ptr Int32
x' Ptr Int32
y'
        if Bool
success
        then do
            Int32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
            Int32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int32
x, Int32
y)
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontGlyphVOrigin' :: Font -> Word32 -> (Int32, Int32)
fontGlyphVOrigin' Font
font Word32
glyph = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
y' -> do
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Word32 -> Ptr Int32 -> Ptr Int32 -> IO Bool
hb_font_get_glyph_v_origin Ptr Font'
font' Word32
glyph Ptr Int32
x' Ptr Int32
y'
        Int32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
        Int32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
x, Int32
y)
foreign import ccall "hb_font_get_glyph_v_origin" hb_font_get_glyph_v_origin ::
    Font_ -> Word32 -> Ptr Int32 -> Ptr Int32 -> IO Bool

-- | Fetches the kerning-adjustment value for a glyph-pair in the specified `Font`.
-- Calls the appropriate direction-specific variant (horizontal or vertical)
-- depending on the value of given `Direction`.
fontGlyphKerningForDir :: Font -> Word32 -> Word32 -> Maybe Direction -> (Int32, Int32)
fontGlyphKerningForDir :: Font -> Word32 -> Word32 -> Maybe Direction -> (Int32, Int32)
fontGlyphKerningForDir Font
font Word32
a Word32
b Maybe Direction
dir = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
y' -> do
        Ptr Font'
-> Word32 -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO ()
hb_font_get_glyph_kerning_for_direction Ptr Font'
font' Word32
a Word32
b (forall {a}. Num a => Maybe Direction -> a
dir2int Maybe Direction
dir) Ptr Int32
x' Ptr Int32
y'
        Int32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
        Int32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
x, Int32
y)
foreign import ccall "hb_font_get_glyph_kerning_for_direction"
    hb_font_get_glyph_kerning_for_direction ::
        Font_ -> Word32 -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO ()

-- | Fetches the glyph-name string for a glyph ID in the specified `Font`.
fontGlyphName :: Font -> Word32 -> Maybe String
fontGlyphName :: Font -> Word32 -> Maybe String
fontGlyphName Font
a Word32
b = Font -> Word32 -> Int -> Maybe String
fontGlyphName_ Font
a Word32
b Int
32
fontGlyphName' :: Font -> Word32 -> String
fontGlyphName' Font
a Word32
b = Font -> Word32 -> Int -> String
fontGlyphName_' Font
a Word32
b Int
32
-- | Variant of `fontGlyphName` which lets you specify the maximum of the return value.
-- Defaults to 32.
fontGlyphName_ :: Font -> Word32 -> Int -> Maybe String
fontGlyphName_ :: Font -> Word32 -> Int -> Maybe String
fontGlyphName_ Font
font Word32
glyph Int
size = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' ->
    forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
size forall a b. (a -> b) -> a -> b
$ \Ptr CChar
name' -> do
        Bool
success <- Ptr Font' -> Word32 -> Ptr CChar -> Word32 -> IO Bool
hb_font_get_glyph_name Ptr Font'
font' Word32
glyph Ptr CChar
name' (forall a. Enum a => Int -> a
toEnum Int
size)
        if Bool
success
        then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO String
peekCStringLen (Ptr CChar
name', Int
size)
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontGlyphName_' :: Font -> Word32 -> Int -> String
fontGlyphName_' Font
font Word32
glyph Int
size = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' ->
    forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
size forall a b. (a -> b) -> a -> b
$ \Ptr CChar
name' -> do
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Word32 -> Ptr CChar -> Word32 -> IO Bool
hb_font_get_glyph_name Ptr Font'
font' Word32
glyph Ptr CChar
name' (forall a. Enum a => Int -> a
toEnum Int
size)
        CStringLen -> IO String
peekCStringLen (Ptr CChar
name', Int
size)
foreign import ccall "hb_font_get_glyph_name" hb_font_get_glyph_name ::
    Font_ -> Word32 -> CString -> Word32 -> IO Bool

-- | Fetches the (X,Y) coordinates of the origin for a glyph in the specified `Font`.
-- Calls the appropriate direction-specific variant (horizontal or vertical)
-- depending on the value of given `Direction`.
fontGlyphOriginForDir :: Font -> Word32 -> Maybe Direction -> (Int32, Int32)
fontGlyphOriginForDir :: Font -> Word32 -> Maybe Direction -> (Int32, Int32)
fontGlyphOriginForDir Font
font Word32
glyph Maybe Direction
dir = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
y' -> do
        Ptr Font' -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO ()
hb_font_get_glyph_origin_for_direction Ptr Font'
font' Word32
glyph (forall {a}. Num a => Maybe Direction -> a
dir2int Maybe Direction
dir) Ptr Int32
x' Ptr Int32
y'
        Int32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
        Int32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
x, Int32
y)
foreign import ccall "hb_font_get_glyph_origin_for_direction"
    hb_font_get_glyph_origin_for_direction ::
        Font_ -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO ()

-- Skipping Draw methodtables, easier to use FreeType for that.

-- | Fetches the nominal glyph ID for a Unicode codepoint in the specified font.
-- This version of the function should not be used to fetch glyph IDs for codepoints
-- modified by variation selectors. For variation-selector support use
-- `fontVarGlyph` or use `fontGlyph`.
fontNominalGlyph :: Font -> Char -> Maybe Word32
fontNominalGlyph :: Font -> Char -> Maybe Word32
fontNominalGlyph Font
font Char
c =
    forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
glyph' -> do
        Bool
success <- Ptr Font' -> Word32 -> Ptr Word32 -> IO Bool
hb_font_get_nominal_glyph Ptr Font'
font' (Char -> Word32
c2w Char
c) Ptr Word32
glyph'
        if Bool
success then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
glyph' else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontNominalGlyph' :: Font -> Char -> Word32
fontNominalGlyph' Font
font Char
c =
    forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
glyph' -> do
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Word32 -> Ptr Word32 -> IO Bool
hb_font_get_nominal_glyph Ptr Font'
font' (Char -> Word32
c2w Char
c) Ptr Word32
glyph'
        forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
glyph'
foreign import ccall "hb_font_get_nominal_glyph" hb_font_get_nominal_glyph ::
    Font_ -> Word32 -> Ptr Word32 -> IO Bool

-- | Fetches the parent of the given `Font`.
fontParent :: Font -> Font
fontParent :: Font -> Font
fontParent Font
child =
    forall a. IO a -> a
unsafeDupablePerformIO (forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
child Ptr Font' -> IO (Ptr Font')
hb_font_get_parent)
foreign import ccall "hb_font_get_parent" hb_font_get_parent :: Font_ -> IO Font_

-- | Fetches the horizontal & vertical points-per-em (ppem) of a `Font`.
fontPPEm :: Font -> (Word32, Word32)
fontPPEm :: Font -> (Word32, Word32)
fontPPEm Font
font =
    forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
y' -> do
        Ptr Font' -> Ptr Word32 -> Ptr Word32 -> IO ()
hb_font_get_ppem Ptr Font'
font' Ptr Word32
x' Ptr Word32
y'
        Word32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
x'
        Word32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
y'
        forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
x, Word32
y)
foreign import ccall "hb_font_get_ppem" hb_font_get_ppem ::
    Font_ -> Ptr Word32 -> Ptr Word32 -> IO ()

-- | Fetches the "point size" of a `Font`. Used in CoreText to implement optical sizing.
fontPtEm :: Font -> Float
fontPtEm :: Font -> Float
fontPtEm = forall a. (Ptr Font' -> a) -> Font -> a
fontFunc Ptr Font' -> Float
hb_font_get_ptem
foreign import ccall "hb_font_get_ptem" hb_font_get_ptem :: Font_ -> Float

-- | Fetches the horizontal and vertical scale of a `Font`.
fontScale :: Font -> (Int, Int)
fontScale :: Font -> (Int, Int)
fontScale Font
font = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
x' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int32
y' -> do
        Ptr Font' -> Ptr Int32 -> Ptr Int32 -> IO ()
hb_font_get_scale Ptr Font'
font' Ptr Int32
x' Ptr Int32
y'
        Int32
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x' :: IO Int32
        Int32
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y' :: IO Int32
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Enum a => a -> Int
fromEnum Int32
x, forall a. Enum a => a -> Int
fromEnum Int32
y)
foreign import ccall "hb_font_get_scale" hb_font_get_scale
    :: Font_ -> Ptr Int32 -> Ptr Int32 -> IO ()

-- | Fetches the "synthetic slant" of a font.
fontSyntheticSlant :: Font -> Float
fontSyntheticSlant :: Font -> Float
fontSyntheticSlant = forall a. (Ptr Font' -> a) -> Font -> a
fontFunc Ptr Font' -> Float
hb_font_get_synthetic_slant
foreign import ccall "hb_font_get_synthetic_slant" hb_font_get_synthetic_slant ::
    Font_ -> Float

-- | Fetches the glyph ID for a Unicode codepoint when followed by
-- the specified variation-selector codepoint, in the specified `Font`.
fontVarGlyph :: Font -> Word32 -> Word32 -> Maybe Word32
fontVarGlyph :: Font -> Word32 -> Word32 -> Maybe Word32
fontVarGlyph Font
font Word32
unicode Word32
varSel = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
glyph' -> do
        Bool
success <- Ptr Font' -> Word32 -> Word32 -> Ptr Word32 -> IO Bool
hb_font_get_variation_glyph Ptr Font'
font' Word32
unicode Word32
varSel Ptr Word32
glyph'
        if Bool
success
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
glyph'
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontVarGlyph' :: Font -> Word32 -> Word32 -> Word32
fontVarGlyph' Font
font Word32
unicode Word32
varSel = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
glyph' -> do
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Word32 -> Word32 -> Ptr Word32 -> IO Bool
hb_font_get_variation_glyph Ptr Font'
font' Word32
unicode Word32
varSel Ptr Word32
glyph'
        forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
glyph'
foreign import ccall "hb_font_get_variation_glyph" hb_font_get_variation_glyph
    :: Font_ -> Word32 -> Word32 -> Ptr Word32 -> IO Bool

-- | Fetches the list of variation coordinates (in design-space units)
-- currently set on a `Font`.
-- Note that this returned list may only contain values for some (or none) of the axes;
-- ommitted axes effectively have their default values.
fontVarCoordsDesign :: Font -> [Float]
fontVarCoordsDesign :: Font -> [Float]
fontVarCoordsDesign Font
font = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word
length' -> do
        Ptr Float
arr <- Ptr Font' -> Ptr Word -> IO (Ptr Float)
hb_font_get_var_coords_design Ptr Font'
font' Ptr Word
length'
        Word
length <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word
length'
        forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a. Enum a => a -> Int
fromEnum Word
length) Ptr Float
arr
foreign import ccall "hb_font_get_var_coords_design"
    hb_font_get_var_coords_design :: Font_ -> Ptr Word -> IO (Ptr Float)

-- | Fetches the list of normalized variation coordinates currently set on a font.
-- Note that this returned list may only contain values for some (or none) of the axes;
-- ommitted axes effectively have default values.
fontVarCoordsNormalized :: Font -> [Int]
fontVarCoordsNormalized :: Font -> [Int]
fontVarCoordsNormalized Font
font = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word
length' -> do
        Ptr Int
arr <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Ptr Word -> IO (Ptr Int)
hb_font_get_var_coords_normalized Ptr Font'
font' Ptr Word
length'
        Word
length <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word
length'
        forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..forall a. Enum a => a -> Int
fromEnum Word
lengthforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int
arr
foreign import ccall "hb_font_get_var_coords_normalized"
    hb_font_get_var_coords_normalized :: Font_ -> Ptr Word -> IO (Ptr Int)

-- | Fetches the glyph ID from given `Font` that matches the specified string.
-- Strings of the format gidDDD or uniUUUU are parsed automatically.
fontTxt2Glyph :: Font -> String -> Maybe Word32
fontTxt2Glyph :: Font -> String -> Maybe Word32
fontTxt2Glyph Font
font String
str = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
ret -> do
        Bool
ok <- forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
str', Int
len) ->
            Ptr Font' -> Ptr CChar -> Int -> Ptr Word32 -> IO Bool
hb_font_glyph_from_string Ptr Font'
font' Ptr CChar
str' Int
len Ptr Word32
ret
        if Bool
ok
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
ret
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontTxt2Glyph' :: Font -> String -> Word32
fontTxt2Glyph' Font
font String
str = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
ret -> do
        IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
str', Int
len) ->
            Ptr Font' -> Ptr CChar -> Int -> Ptr Word32 -> IO Bool
hb_font_glyph_from_string Ptr Font'
font' Ptr CChar
str' Int
len Ptr Word32
ret
        forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
ret
foreign import ccall "hb_font_glyph_from_string" hb_font_glyph_from_string
    :: Font_ -> CString -> Int -> Ptr Word32 -> IO Bool

-- | Fetches the name of the specified glyph ID in given `Font` as a string.
-- If the glyph ID has no name in the `Font`, a string of the form gidDDD is generated
-- with DDD being the glyph ID.
fontGlyph2Str :: Font -> Word32 -> Int -> String
fontGlyph2Str :: Font -> Word32 -> Int -> String
fontGlyph2Str Font
font Word32
glyph Int
length = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
length forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ret -> do
        Ptr Font' -> Word32 -> Ptr CChar -> Int -> IO ()
hb_font_glyph_to_string Ptr Font'
font' Word32
glyph Ptr CChar
ret Int
length
        Ptr CChar -> IO String
peekCString Ptr CChar
ret
foreign import ccall "hb_font_glyph_to_string" hb_font_glyph_to_string
    :: Font_ -> Word32 -> CString -> Int -> IO ()

-- | Font-wide extent values, measured in font units.
-- Note that typically ascender is positive and descender is negative,
-- in coordinate systems that grow up.
-- Note: Due to presence of 9 additional private fields,
-- arrays of font extents will not decode correctly. So far this doesn't matter.
data FontExtents = FontExtents {
    FontExtents -> Int32
ascender :: Int32,
    -- ^ The height of typographic ascenders.
    FontExtents -> Int32
descender :: Int32,
    -- ^ The depth of typographic descenders.
    FontExtents -> Int32
lineGap :: Int32
    -- ^ The suggested line-spacing gap.
} deriving (forall x. Rep FontExtents x -> FontExtents
forall x. FontExtents -> Rep FontExtents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontExtents x -> FontExtents
$cfrom :: forall x. FontExtents -> Rep FontExtents x
Generic, ReadPrec [FontExtents]
ReadPrec FontExtents
Int -> ReadS FontExtents
ReadS [FontExtents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FontExtents]
$creadListPrec :: ReadPrec [FontExtents]
readPrec :: ReadPrec FontExtents
$creadPrec :: ReadPrec FontExtents
readList :: ReadS [FontExtents]
$creadList :: ReadS [FontExtents]
readsPrec :: Int -> ReadS FontExtents
$creadsPrec :: Int -> ReadS FontExtents
Read, Int -> FontExtents -> ShowS
[FontExtents] -> ShowS
FontExtents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontExtents] -> ShowS
$cshowList :: [FontExtents] -> ShowS
show :: FontExtents -> String
$cshow :: FontExtents -> String
showsPrec :: Int -> FontExtents -> ShowS
$cshowsPrec :: Int -> FontExtents -> ShowS
Show, Eq FontExtents
FontExtents -> FontExtents -> Bool
FontExtents -> FontExtents -> Ordering
FontExtents -> FontExtents -> FontExtents
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontExtents -> FontExtents -> FontExtents
$cmin :: FontExtents -> FontExtents -> FontExtents
max :: FontExtents -> FontExtents -> FontExtents
$cmax :: FontExtents -> FontExtents -> FontExtents
>= :: FontExtents -> FontExtents -> Bool
$c>= :: FontExtents -> FontExtents -> Bool
> :: FontExtents -> FontExtents -> Bool
$c> :: FontExtents -> FontExtents -> Bool
<= :: FontExtents -> FontExtents -> Bool
$c<= :: FontExtents -> FontExtents -> Bool
< :: FontExtents -> FontExtents -> Bool
$c< :: FontExtents -> FontExtents -> Bool
compare :: FontExtents -> FontExtents -> Ordering
$ccompare :: FontExtents -> FontExtents -> Ordering
Ord, FontExtents -> FontExtents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontExtents -> FontExtents -> Bool
$c/= :: FontExtents -> FontExtents -> Bool
== :: FontExtents -> FontExtents -> Bool
$c== :: FontExtents -> FontExtents -> Bool
Eq)
instance GStorable FontExtents
-- | Fetches the extents for a font in a text segment of the specified direction.
-- Calls the appropriate direction-specific variant (horizontal or vertical)
-- depending on the value of direction .
fontExtentsForDir :: Font -> Maybe Direction -> FontExtents
fontExtentsForDir :: Font -> Maybe Direction -> FontExtents
fontExtentsForDir Font
font Maybe Direction
dir = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr FontExtents
ret -> do
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' ->
        Ptr Font' -> Int -> Ptr FontExtents -> IO ()
hb_font_get_extents_for_direction Ptr Font'
font' (forall {a}. Num a => Maybe Direction -> a
dir2int Maybe Direction
dir) Ptr FontExtents
ret
    forall a. Storable a => Ptr a -> IO a
peek Ptr FontExtents
ret
foreign import ccall "hb_font_get_extents_for_direction"
    hb_font_get_extents_for_direction :: Font_ -> Int -> Ptr FontExtents -> IO ()

-- | Fetches the extents for a specified font, for horizontal text segments.
fontHExtents :: Font -> Maybe FontExtents
fontHExtents Font
font = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr FontExtents
ret -> do
    Bool
ok <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> Ptr Font' -> Ptr FontExtents -> IO Bool
hb_font_get_h_extents Ptr Font'
font' Ptr FontExtents
ret
    if Bool
ok
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr FontExtents
ret
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontHExtents' :: Font -> FontExtents
fontHExtents' Font
font = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr FontExtents
ret -> do
    IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> Ptr Font' -> Ptr FontExtents -> IO Bool
hb_font_get_h_extents Ptr Font'
font' Ptr FontExtents
ret
    forall a. Storable a => Ptr a -> IO a
peek Ptr FontExtents
ret
foreign import ccall "hb_font_get_h_extents" hb_font_get_h_extents
    :: Font_ -> Ptr FontExtents -> IO Bool

-- | Fetches the extents for a specified font, for vertical text segments.
fontVExtents :: Font -> Maybe FontExtents
fontVExtents Font
font = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr FontExtents
ret -> do
    Bool
ok <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> Ptr Font' -> Ptr FontExtents -> IO Bool
hb_font_get_v_extents Ptr Font'
font' Ptr FontExtents
ret
    if Bool
ok
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr FontExtents
ret
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
fontVExtents' :: Font -> FontExtents
fontVExtents' Font
font = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr FontExtents
ret -> do
    IO Bool -> IO ()
throwFalse forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> Ptr Font' -> Ptr FontExtents -> IO Bool
hb_font_get_v_extents Ptr Font'
font' Ptr FontExtents
ret
    forall a. Storable a => Ptr a -> IO a
peek Ptr FontExtents
ret
foreign import ccall "hb_font_get_v_extents" hb_font_get_v_extents
    :: Font_ -> Ptr FontExtents -> IO Bool

-- Not exposing the Font Funcs API as being extremely imperative with little value to callers.

------
--- Configurable fonts
------

-- | Allows configuring properties on a `Font` when creating it.
data FontOptions = FontOptions {
    FontOptions -> Maybe (Word, Word)
optionPPEm :: Maybe (Word, Word),
    -- ^ Sets the horizontal and vertical pixels-per-em (ppem) of the newly-created `Font`.
    FontOptions -> Maybe Float
optionPtEm :: Maybe Float,
    -- ^ Sets the "point size" of a newly-created `Font`.
    -- Used in CoreText to implement optical sizing.
    -- Note: There are 72 points in an inch.
    FontOptions -> Maybe (Int, Int)
optionScale :: Maybe (Int, Int),
    -- ^ Sets the horizontal and vertical scale of a newly-created `Font`.
    FontOptions -> Maybe Face
optionFace :: Maybe Face,
    -- ^ Sets the font-face value of the newly-created `Font`.
    FontOptions -> Maybe Font
optionParent :: Maybe Font,
    -- ^ Sets the parent `Font` of the newly-created `Font`.
    FontOptions -> Maybe Float
optionSynthSlant :: Maybe Float,
    -- ^ Sets the "synthetic slant" of a newly-created `Font`. By default is zero.
    -- Synthetic slant is the graphical skew applied to the font at rendering time.
    -- Harfbuzz needs to know this value to adjust shaping results, metrics,
    -- and style valuesto match the slanted rendering.
    -- Note: The slant value is a ratio. For example, a 20% slant would be
    -- represented as a 0.2 value.
    FontOptions -> [Variation]
optionVariations :: [Variation],
    -- ^ Applies a list of font-variation settings to a font.
    -- Axes not included will be effectively set to their default values.
    FontOptions -> [Float]
optionVarCoordsDesign :: [Float],
    -- ^ Applies a list of variation coordinates (in design-space units)
    -- to a newly-created `Font`.
    -- Axes not included in coords will be effectively set to their default values.
    FontOptions -> [Int]
optionVarCoordsNormalized :: [Int],
    -- ^ Applies a list of variation coordinates (in normalized units)
    -- to a newly-created `Font`.
    -- Axes not included in coords will be effectively set to their default values.
    FontOptions -> Maybe Word
optionVarNamedInstance :: Maybe Word
    -- ^ Sets design coords of a font from a named instance index.
} deriving (Int -> FontOptions -> ShowS
[FontOptions] -> ShowS
FontOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontOptions] -> ShowS
$cshowList :: [FontOptions] -> ShowS
show :: FontOptions -> String
$cshow :: FontOptions -> String
showsPrec :: Int -> FontOptions -> ShowS
$cshowsPrec :: Int -> FontOptions -> ShowS
Show, Eq FontOptions
FontOptions -> FontOptions -> Bool
FontOptions -> FontOptions -> Ordering
FontOptions -> FontOptions -> FontOptions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontOptions -> FontOptions -> FontOptions
$cmin :: FontOptions -> FontOptions -> FontOptions
max :: FontOptions -> FontOptions -> FontOptions
$cmax :: FontOptions -> FontOptions -> FontOptions
>= :: FontOptions -> FontOptions -> Bool
$c>= :: FontOptions -> FontOptions -> Bool
> :: FontOptions -> FontOptions -> Bool
$c> :: FontOptions -> FontOptions -> Bool
<= :: FontOptions -> FontOptions -> Bool
$c<= :: FontOptions -> FontOptions -> Bool
< :: FontOptions -> FontOptions -> Bool
$c< :: FontOptions -> FontOptions -> Bool
compare :: FontOptions -> FontOptions -> Ordering
$ccompare :: FontOptions -> FontOptions -> Ordering
Ord, FontOptions -> FontOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontOptions -> FontOptions -> Bool
$c/= :: FontOptions -> FontOptions -> Bool
== :: FontOptions -> FontOptions -> Bool
$c== :: FontOptions -> FontOptions -> Bool
Eq)
-- | `FontOptions` which has no effect on the newly-created `Font`.
defaultFontOptions :: FontOptions
defaultFontOptions = FontOptions {
    optionPPEm :: Maybe (Word, Word)
optionPPEm = forall a. Maybe a
Nothing, optionPtEm :: Maybe Float
optionPtEm = forall a. Maybe a
Nothing, optionScale :: Maybe (Int, Int)
optionScale = forall a. Maybe a
Nothing,
    optionFace :: Maybe Face
optionFace = forall a. Maybe a
Nothing, optionParent :: Maybe Font
optionParent = forall a. Maybe a
Nothing, optionSynthSlant :: Maybe Float
optionSynthSlant = forall a. Maybe a
Nothing,
    optionVariations :: [Variation]
optionVariations = [], optionVarCoordsDesign :: [Float]
optionVarCoordsDesign = [], optionVarCoordsNormalized :: [Int]
optionVarCoordsNormalized = [],
    optionVarNamedInstance :: Maybe Word
optionVarNamedInstance = forall a. Maybe a
Nothing
}
-- | Internal utility to apply the given `FontOptions` to the given `Font`.
_setFontOptions :: Ptr Font' -> FontOptions -> IO ()
_setFontOptions Ptr Font'
font FontOptions
opts = do
    case FontOptions -> Maybe (Word, Word)
optionPPEm FontOptions
opts of
        Just (Word
x, Word
y) -> Ptr Font' -> Word -> Word -> IO ()
hb_font_set_ppem Ptr Font'
font Word
x Word
y
        Maybe (Word, Word)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case FontOptions -> Maybe Float
optionPtEm FontOptions
opts of
        Just Float
ptem -> Ptr Font' -> Float -> IO ()
hb_font_set_ptem Ptr Font'
font Float
ptem
        Maybe Float
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case FontOptions -> Maybe (Int, Int)
optionScale FontOptions
opts of
        Just (Int
x, Int
y) -> Ptr Font' -> Int -> Int -> IO ()
hb_font_set_scale Ptr Font'
font Int
x Int
y
        Maybe (Int, Int)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case FontOptions -> Maybe Face
optionFace FontOptions
opts of
        Just Face
face -> forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
face forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Ptr Face' -> IO ()
hb_font_set_face Ptr Font'
font
        Maybe Face
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case FontOptions -> Maybe Font
optionParent FontOptions
opts of
        Just Font
parent -> forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
parent forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Ptr Font' -> IO ()
hb_font_set_parent Ptr Font'
font
        Maybe Font
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case FontOptions -> Maybe Float
optionSynthSlant FontOptions
opts of
        Just Float
slant -> Ptr Font' -> Float -> IO ()
hb_font_set_synthetic_slant Ptr Font'
font Float
slant
        Maybe Float
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ FontOptions -> [Variation]
optionVariations FontOptions
opts) forall a b. (a -> b) -> a -> b
$
        forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (FontOptions -> [Variation]
optionVariations FontOptions
opts) forall a b. (a -> b) -> a -> b
$ \Int
len Ptr Variation
vars ->
            Ptr Font' -> Ptr Variation -> Word -> IO ()
hb_font_set_variations Ptr Font'
font Ptr Variation
vars forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
len
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ FontOptions -> [Float]
optionVarCoordsDesign FontOptions
opts) forall a b. (a -> b) -> a -> b
$
        forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (FontOptions -> [Float]
optionVarCoordsDesign FontOptions
opts) forall a b. (a -> b) -> a -> b
$ \Int
len Ptr Float
coords ->
            Ptr Font' -> Ptr Float -> Word -> IO ()
hb_font_set_var_coords_design Ptr Font'
font Ptr Float
coords forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
len
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ FontOptions -> [Int]
optionVarCoordsNormalized FontOptions
opts) forall a b. (a -> b) -> a -> b
$
        forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (FontOptions -> [Int]
optionVarCoordsNormalized FontOptions
opts) forall a b. (a -> b) -> a -> b
$ \Int
len Ptr Int
coords ->
            Ptr Font' -> Ptr Int -> Word -> IO ()
hb_font_set_var_coords_normalized Ptr Font'
font Ptr Int
coords forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
len
    case FontOptions -> Maybe Word
optionVarNamedInstance FontOptions
opts of
        Just Word
inst -> Ptr Font' -> Word -> IO ()
hb_font_set_var_named_instance Ptr Font'
font Word
inst
        Maybe Word
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall "hb_font_set_ppem" hb_font_set_ppem :: Font_ -> Word -> Word -> IO ()
foreign import ccall "hb_font_set_ptem" hb_font_set_ptem :: Font_ -> Float -> IO ()
foreign import ccall "hb_font_set_scale" hb_font_set_scale :: Font_ -> Int -> Int -> IO ()
foreign import ccall "hb_font_set_face" hb_font_set_face :: Font_ -> Face_ -> IO ()
foreign import ccall "hb_font_set_parent" hb_font_set_parent :: Font_ -> Font_ -> IO ()
foreign import ccall "hb_font_set_synthetic_slant" hb_font_set_synthetic_slant ::
    Font_ -> Float -> IO ()
foreign import ccall "hb_font_set_variations" hb_font_set_variations ::
    Font_ -> Ptr Variation -> Word -> IO ()
foreign import ccall "hb_font_set_var_coords_design" hb_font_set_var_coords_design ::
    Font_ -> Ptr Float -> Word -> IO ()
foreign import ccall "hb_font_set_var_coords_normalized"
    hb_font_set_var_coords_normalized :: Font_ -> Ptr Int -> Word -> IO ()
foreign import ccall "hb_font_set_var_named_instance" hb_font_set_var_named_instance ::
    Font_ -> Word -> IO ()

-- | Variant of `createFont` which applies the given `FontOptions`.
createFontWithOptions :: FontOptions -> Face -> Font
createFontWithOptions :: FontOptions -> Face -> Font
createFontWithOptions FontOptions
opts Face
fce = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Ptr Font'
font <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
fce forall a b. (a -> b) -> a -> b
$ Ptr Face' -> IO (Ptr Font')
hb_font_create
    Ptr Font' -> FontOptions -> IO ()
_setFontOptions Ptr Font'
font FontOptions
opts
    Ptr Font' -> IO ()
hb_font_make_immutable Ptr Font'
font
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Font' -> IO ())
hb_font_destroy Ptr Font'
font

-- | Variant of `ftCreateFont` which applies the given `FontOptions`.
ftCreateFontWithOptions :: FontOptions -> FT_Face -> Font
ftCreateFontWithOptions :: FontOptions -> FT_Face -> Font
ftCreateFontWithOptions FontOptions
opts FT_Face
fce = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Ptr Font'
font <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ FT_Face -> IO (Ptr Font')
hb_ft_font_create_referenced FT_Face
fce
    Ptr Font' -> FontOptions -> IO ()
_setFontOptions Ptr Font'
font FontOptions
opts
    Ptr Font' -> IO ()
hb_font_make_immutable Ptr Font'
font
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Font' -> IO ())
hb_font_destroy Ptr Font'
font

-- | Variant of createSubFont which applies the given `FontOptions`.
createSubFontWithOptions :: FontOptions -> Font -> Font
createSubFontWithOptions :: FontOptions -> Font -> Font
createSubFontWithOptions FontOptions
opts Font
font = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Ptr Font'
font <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ Ptr Font' -> IO (Ptr Font')
hb_font_create_sub_font
    Ptr Font' -> FontOptions -> IO ()
_setFontOptions Ptr Font'
font FontOptions
opts
    Ptr Font' -> IO ()
hb_font_make_immutable Ptr Font'
font
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr Font' -> IO ())
hb_font_destroy Ptr Font'
font

------
--- Internal
------

-- | Harfbuzz's equivalent to the ByteString type.
type Blob = ForeignPtr Blob'
data Blob'
type Blob_ = Ptr Blob'
-- | Convert from a ByteString to Harfbuzz's equivalent.
bs2blob :: ByteString -> IO Blob
bs2blob :: ByteString -> IO Blob
bs2blob (BS ForeignPtr Word8
bytes Int
len) = do
    Blob_
blob <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
bytes forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bytes' ->
        Ptr Word8
-> Int -> Int -> Ptr () -> FunPtr (Ptr () -> IO ()) -> IO Blob_
hb_blob_create Ptr Word8
bytes' Int
len Int
hb_MEMORY_MODE_DUPLICATE forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Blob_ -> IO ())
hb_blob_destroy Blob_
blob
-- | Convert from a ByteString to a temporary copy of Harfbuzz's equivalent.
-- Do not use this Blob outside the passed callback.
withBlob :: ByteString -> (Blob_ -> IO a) -> IO a
withBlob :: forall a. ByteString -> (Blob_ -> IO a) -> IO a
withBlob (BS ForeignPtr Word8
bytes Int
len) Blob_ -> IO a
cb = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
bytes forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bytes' -> do
    forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr Word8
bytes'
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (Ptr Word8
-> Int -> Int -> Ptr () -> FunPtr (Ptr () -> IO ()) -> IO Blob_
hb_blob_create Ptr Word8
bytes' Int
len Int
hb_MEMORY_MODE_READONLY forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr)
        Blob_ -> IO ()
hb_blob_destroy' Blob_ -> IO a
cb
foreign import ccall "hb_blob_create" hb_blob_create ::
    Ptr Word8 -> Int -> Int -> Ptr () -> FunPtr (Ptr () -> IO ()) -> IO Blob_
hb_MEMORY_MODE_DUPLICATE :: Int
hb_MEMORY_MODE_DUPLICATE = Int
0
hb_MEMORY_MODE_READONLY :: Int
hb_MEMORY_MODE_READONLY = Int
1
foreign import ccall "&hb_blob_destroy" hb_blob_destroy :: FunPtr (Blob_ -> IO ())

-- | Convert to a ByteString from Harfbuzz's equivalent.
blob2bs :: Blob_ -> ByteString
blob2bs :: Blob_ -> ByteString
blob2bs Blob_
blob = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word
length' -> do
    Ptr CChar
dat <- Blob_ -> Ptr Word -> IO (Ptr CChar)
hb_blob_get_data Blob_
blob Ptr Word
length'
    Word
length <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word
length'
    ByteString
ret <- CStringLen -> IO ByteString
packCStringLen (Ptr CChar
dat, forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
length)
    Blob_ -> IO ()
hb_blob_destroy' Blob_
blob
    forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
ret
foreign import ccall "hb_blob_get_data" hb_blob_get_data :: Blob_ -> Ptr Word -> IO CString
foreign import ccall "hb_blob_destroy" hb_blob_destroy' :: Blob_ -> IO ()

-- | Internal utility for defining trivial language bindings unwrapping `Face` foreign pointers.
faceFunc :: (Face_ -> a) -> (Face -> a)
faceFunc :: forall a. (Ptr Face' -> a) -> Face -> a
faceFunc Ptr Face' -> a
cb Face
fce = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
fce forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Face' -> a
cb

-- | Internal utility for defining trivial language bindings unwrapping `Font` foreign pointers.
fontFunc :: (Font_ -> a) -> (Font -> a)
fontFunc :: forall a. (Ptr Font' -> a) -> Font -> a
fontFunc Ptr Font' -> a
cb Font
fnt = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
fnt forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font' -> a
cb

-- | Internal utility for exposing Harfbuzz functions that populate a bitset.
-- Converts the populated bitset to a Haskell lazy linked-list.
faceCollectFunc :: (Face_ -> Set_ -> IO ()) -> (Face -> [Word32])
faceCollectFunc :: (Ptr Face' -> Set_ -> IO ()) -> Face -> [Word32]
faceCollectFunc Ptr Face' -> Set_ -> IO ()
cb Face
fce = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
fce forall a b. (a -> b) -> a -> b
$ \Ptr Face'
fce' -> do
    Set
set <- IO Set
createSet
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Set
set forall a b. (a -> b) -> a -> b
$ Ptr Face' -> Set_ -> IO ()
cb Ptr Face'
fce'
    Set -> IO [Word32]
set2list Set
set

-- | A Harfbuzz bitset.
data Set'
type Set = ForeignPtr Set'
type Set_ = Ptr Set'
-- | Creates a Harfbuzz bitset wrapping it in a foreignpointer.
createSet :: IO Set
createSet :: IO Set
createSet = do
    Set_
ret <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull IO Set_
hb_set_create
    forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Set_ -> IO ())
hb_set_destroy Set_
ret
foreign import ccall "hb_set_create" hb_set_create :: IO Set_
foreign import ccall "&hb_set_destroy" hb_set_destroy :: FunPtr (Set_ -> IO ())

-- | Lazily retrieves the next codepoint in a bitset.
setNext :: Set -> Word32 -> Maybe Word32
setNext :: Set -> Word32 -> Maybe Word32
setNext Set
set Word32
iter = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Set
set forall a b. (a -> b) -> a -> b
$ \Set_
set' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
iter' -> do
    forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word32
iter' Word32
iter
    Bool
success <- Set_ -> Ptr Word32 -> IO Bool
hb_set_next Set_
set' Ptr Word32
iter'
    if Bool
success
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
iter'
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
foreign import ccall "hb_set_next" hb_set_next :: Set_ -> Ptr Word32 -> IO Bool

-- | Converts a Harfbuzz bitset into a lazy linkedlist.
set2list :: Set -> IO [Word32]
set2list :: Set -> IO [Word32]
set2list Set
set = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word32 -> [Word32]
inner forall a. Bounded a => a
maxBound
  where
    inner :: Word32 -> [Word32]
inner Word32
iter | Just Word32
x <- Set -> Word32 -> Maybe Word32
setNext Set
set Word32
iter = Word32
x forall a. a -> [a] -> [a]
: Word32 -> [Word32]
inner Word32
x
        | Bool
otherwise = []