{-# 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 Data.Maybe (fromMaybe)
import System.IO.Unsafe (unsafePerformIO)
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)
import Foreign.Storable (Storable(..))
import Foreign.Storable.Generic (GStorable(..))
import GHC.Generics (Generic(..))
import Foreign.C.String (CString, withCString, withCStringLen, peekCString, peekCStringLen)
data Feature = Feature {
Feature -> Word32
featTag' :: Word32,
Feature -> Word32
featValue :: Word32,
Feature -> Word
featStart :: Word,
Feature -> Word
featEnd :: Word
} deriving (ReadPrec [Feature]
ReadPrec Feature
Int -> ReadS Feature
ReadS [Feature]
(Int -> ReadS Feature)
-> ReadS [Feature]
-> ReadPrec Feature
-> ReadPrec [Feature]
-> Read 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
(Int -> Feature -> ShowS)
-> (Feature -> String) -> ([Feature] -> ShowS) -> Show Feature
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. Feature -> Rep Feature x)
-> (forall x. Rep Feature x -> Feature) -> Generic Feature
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
Eq Feature =>
(Feature -> Feature -> Ordering)
-> (Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool)
-> (Feature -> Feature -> Feature)
-> (Feature -> Feature -> Feature)
-> Ord 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
$cp1Ord :: Eq Feature
Ord, Feature -> Feature -> Bool
(Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool) -> Eq Feature
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
parseFeature :: String -> Maybe Feature
parseFeature :: String -> Maybe Feature
parseFeature str :: String
str = IO (Maybe Feature) -> Maybe Feature
forall a. IO a -> a
unsafePerformIO (IO (Maybe Feature) -> Maybe Feature)
-> IO (Maybe Feature) -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ String -> (CStringLen -> IO (Maybe Feature)) -> IO (Maybe Feature)
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str ((CStringLen -> IO (Maybe Feature)) -> IO (Maybe Feature))
-> (CStringLen -> IO (Maybe Feature)) -> IO (Maybe Feature)
forall a b. (a -> b) -> a -> b
$ \(str' :: Ptr CChar
str', len :: Int
len) -> (Ptr Feature -> IO (Maybe Feature)) -> IO (Maybe Feature)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Feature -> IO (Maybe Feature)) -> IO (Maybe Feature))
-> (Ptr Feature -> IO (Maybe Feature)) -> IO (Maybe Feature)
forall a b. (a -> b) -> a -> b
$ \ret' :: 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 Feature -> Maybe Feature
forall a. a -> Maybe a
Just (Feature -> Maybe Feature) -> IO Feature -> IO (Maybe Feature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Feature -> IO Feature
forall a. Storable a => Ptr a -> IO a
peek Ptr Feature
ret' else Maybe Feature -> IO (Maybe Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Feature
forall a. Maybe a
Nothing
parseFeature' :: String -> Feature
parseFeature' str :: String
str = IO Feature -> Feature
forall a. IO a -> a
unsafePerformIO (IO Feature -> Feature) -> IO Feature -> Feature
forall a b. (a -> b) -> a -> b
$ String -> (CStringLen -> IO Feature) -> IO Feature
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str ((CStringLen -> IO Feature) -> IO Feature)
-> (CStringLen -> IO Feature) -> IO Feature
forall a b. (a -> b) -> a -> b
$ \(str' :: Ptr CChar
str', len :: Int
len) -> (Ptr Feature -> IO Feature) -> IO Feature
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Feature -> IO Feature) -> IO Feature)
-> (Ptr Feature -> IO Feature) -> IO Feature
forall a b. (a -> b) -> a -> b
$ \ret' :: Ptr Feature
ret' -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
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'
Ptr Feature -> IO Feature
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
unparseFeature :: Feature -> String
unparseFeature :: Feature -> String
unparseFeature feature :: Feature
feature = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ (Ptr Feature -> IO String) -> IO String
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Feature -> IO String) -> IO String)
-> (Ptr Feature -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \feature' :: Ptr Feature
feature' -> Int -> (Ptr CChar -> IO String) -> IO String
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 128 ((Ptr CChar -> IO String) -> IO String)
-> (Ptr CChar -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \ret' :: Ptr CChar
ret' -> do
Ptr Feature
feature' Ptr Feature -> Feature -> IO ()
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' 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 Variation = Variation {
Variation -> Word32
varTag' :: Word32,
Variation -> Float
varValue :: Float
} deriving (ReadPrec [Variation]
ReadPrec Variation
Int -> ReadS Variation
ReadS [Variation]
(Int -> ReadS Variation)
-> ReadS [Variation]
-> ReadPrec Variation
-> ReadPrec [Variation]
-> Read 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
(Int -> Variation -> ShowS)
-> (Variation -> String)
-> ([Variation] -> ShowS)
-> Show Variation
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. Variation -> Rep Variation x)
-> (forall x. Rep Variation x -> Variation) -> Generic Variation
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
Eq Variation =>
(Variation -> Variation -> Ordering)
-> (Variation -> Variation -> Bool)
-> (Variation -> Variation -> Bool)
-> (Variation -> Variation -> Bool)
-> (Variation -> Variation -> Bool)
-> (Variation -> Variation -> Variation)
-> (Variation -> Variation -> Variation)
-> Ord 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
$cp1Ord :: Eq Variation
Ord, Variation -> Variation -> Bool
(Variation -> Variation -> Bool)
-> (Variation -> Variation -> Bool) -> Eq Variation
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
parseVariation :: String -> Maybe Variation
parseVariation :: String -> Maybe Variation
parseVariation str :: String
str = IO (Maybe Variation) -> Maybe Variation
forall a. IO a -> a
unsafePerformIO (IO (Maybe Variation) -> Maybe Variation)
-> IO (Maybe Variation) -> Maybe Variation
forall a b. (a -> b) -> a -> b
$ String
-> (CStringLen -> IO (Maybe Variation)) -> IO (Maybe Variation)
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str ((CStringLen -> IO (Maybe Variation)) -> IO (Maybe Variation))
-> (CStringLen -> IO (Maybe Variation)) -> IO (Maybe Variation)
forall a b. (a -> b) -> a -> b
$ \(str' :: Ptr CChar
str', len :: Int
len) -> (Ptr Variation -> IO (Maybe Variation)) -> IO (Maybe Variation)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Variation -> IO (Maybe Variation)) -> IO (Maybe Variation))
-> (Ptr Variation -> IO (Maybe Variation)) -> IO (Maybe Variation)
forall a b. (a -> b) -> a -> b
$ \ret' :: 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 Variation -> Maybe Variation
forall a. a -> Maybe a
Just (Variation -> Maybe Variation)
-> IO Variation -> IO (Maybe Variation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Variation -> IO Variation
forall a. Storable a => Ptr a -> IO a
peek Ptr Variation
ret' else Maybe Variation -> IO (Maybe Variation)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Variation
forall a. Maybe a
Nothing
parseVariation' :: String -> Variation
parseVariation' str :: String
str = IO Variation -> Variation
forall a. IO a -> a
unsafePerformIO (IO Variation -> Variation) -> IO Variation -> Variation
forall a b. (a -> b) -> a -> b
$ String -> (CStringLen -> IO Variation) -> IO Variation
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str ((CStringLen -> IO Variation) -> IO Variation)
-> (CStringLen -> IO Variation) -> IO Variation
forall a b. (a -> b) -> a -> b
$ \(str' :: Ptr CChar
str', len :: Int
len) -> (Ptr Variation -> IO Variation) -> IO Variation
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Variation -> IO Variation) -> IO Variation)
-> (Ptr Variation -> IO Variation) -> IO Variation
forall a b. (a -> b) -> a -> b
$ \ret' :: Ptr Variation
ret' -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
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'
Ptr Variation -> IO Variation
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
unparseVariation :: Variation -> String
unparseVariation var :: Variation
var = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ (Ptr Variation -> IO String) -> IO String
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Variation -> IO String) -> IO String)
-> (Ptr Variation -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \var' :: Ptr Variation
var' -> Int -> (Ptr CChar -> IO String) -> IO String
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 128 ((Ptr CChar -> IO String) -> IO String)
-> (Ptr CChar -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \ret' :: Ptr CChar
ret' -> do
Ptr Variation
var' Ptr Variation -> Variation -> IO ()
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' 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 ()
featTag :: Feature -> String
featTag = Word32 -> String
tag_to_string (Word32 -> String) -> (Feature -> Word32) -> Feature -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Feature -> Word32
featTag'
varTag :: Variation -> String
varTag = Word32 -> String
tag_to_string (Word32 -> String) -> (Variation -> Word32) -> Variation -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Variation -> Word32
varTag'
globalStart, globalEnd :: Word
globalStart :: Word
globalStart = 0
globalEnd :: Word
globalEnd = Word
forall a. Bounded a => a
maxBound
countFace :: ByteString -> Word
countFace :: ByteString -> Word
countFace bytes :: ByteString
bytes = IO Word -> Word
forall a. IO a -> a
unsafePerformIO (IO Word -> Word) -> IO Word -> Word
forall a b. (a -> b) -> a -> b
$ do
Blob
blob <- ByteString -> IO Blob
bs2blob ByteString
bytes
Blob -> (Ptr Blob' -> IO Word) -> IO Word
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Blob
blob Ptr Blob' -> IO Word
hb_face_count
foreign import ccall "hb_face_count" hb_face_count :: Blob_ -> IO Word
type Face = ForeignPtr Face'
type Face_ = Ptr Face'
data Face'
createFace :: ByteString -> Word -> Face
createFace :: ByteString -> Word -> Face
createFace bytes :: ByteString
bytes index :: Word
index = IO Face -> Face
forall a. IO a -> a
unsafePerformIO (IO Face -> Face) -> IO Face -> Face
forall a b. (a -> b) -> a -> b
$ do
Blob
blob <- ByteString -> IO Blob
bs2blob ByteString
bytes
Ptr Face'
face <- Blob -> (Ptr Blob' -> IO (Ptr Face')) -> IO (Ptr Face')
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Blob
blob ((Ptr Blob' -> IO (Ptr Face')) -> IO (Ptr Face'))
-> (Ptr Blob' -> IO (Ptr Face')) -> IO (Ptr Face')
forall a b. (a -> b) -> a -> b
$ IO (Ptr Face') -> IO (Ptr Face')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Face') -> IO (Ptr Face'))
-> (Ptr Blob' -> IO (Ptr Face')) -> Ptr Blob' -> IO (Ptr Face')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Blob' -> Word -> IO (Ptr Face'))
-> Word -> Ptr Blob' -> IO (Ptr Face')
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Blob' -> Word -> IO (Ptr Face')
hb_face_create Word
index
Ptr Face' -> IO ()
hb_face_make_immutable Ptr Face'
face
FinalizerPtr Face' -> Ptr Face' -> IO Face
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Face'
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 ())
ftCreateFace :: FT_Face -> IO Face
ftCreateFace :: FT_Face -> IO Face
ftCreateFace ft :: FT_Face
ft = do
Ptr Face'
ret <- IO (Ptr Face') -> IO (Ptr Face')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Face') -> IO (Ptr Face'))
-> IO (Ptr Face') -> IO (Ptr Face')
forall a b. (a -> b) -> a -> b
$ FT_Face -> IO (Ptr Face')
hb_ft_face_create_referenced FT_Face
ft
FinalizerPtr Face' -> Ptr Face' -> IO Face
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Face'
hb_face_destroy Ptr Face'
ret
foreign import ccall "hb_ft_face_create_referenced" hb_ft_face_create_referenced
:: FT_Face -> IO Face_
emptyFace :: Face
emptyFace :: Face
emptyFace = IO Face -> Face
forall a. IO a -> a
unsafePerformIO (IO Face -> Face) -> IO Face -> Face
forall a b. (a -> b) -> a -> b
$ FinalizerPtr Face' -> Ptr Face' -> IO Face
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Face'
hb_face_destroy Ptr Face'
hb_face_get_empty
foreign import ccall "hb_face_get_empty" hb_face_get_empty :: Face_
faceTableTags :: Face -> Word -> Word -> (Word, [String])
faceTableTags :: Face -> Word -> Word -> (Word, [String])
faceTableTags fce :: Face
fce offs :: Word
offs cnt :: Word
cnt = IO (Word, [String]) -> (Word, [String])
forall a. IO a -> a
unsafePerformIO (IO (Word, [String]) -> (Word, [String]))
-> IO (Word, [String]) -> (Word, [String])
forall a b. (a -> b) -> a -> b
$ Face -> (Ptr Face' -> IO (Word, [String])) -> IO (Word, [String])
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
fce ((Ptr Face' -> IO (Word, [String])) -> IO (Word, [String]))
-> (Ptr Face' -> IO (Word, [String])) -> IO (Word, [String])
forall a b. (a -> b) -> a -> b
$ \fce' :: Ptr Face'
fce' -> do
(Ptr Word -> IO (Word, [String])) -> IO (Word, [String])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word -> IO (Word, [String])) -> IO (Word, [String]))
-> (Ptr Word -> IO (Word, [String])) -> IO (Word, [String])
forall a b. (a -> b) -> a -> b
$ \cnt' :: Ptr Word
cnt' -> Int -> (Ptr Word32 -> IO (Word, [String])) -> IO (Word, [String])
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) ((Ptr Word32 -> IO (Word, [String])) -> IO (Word, [String]))
-> (Ptr Word32 -> IO (Word, [String])) -> IO (Word, [String])
forall a b. (a -> b) -> a -> b
$ \arr' :: Ptr Word32
arr' -> do
Ptr Word -> Word -> IO ()
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_ <- Ptr Word -> IO Word
forall a. Storable a => Ptr a -> IO a
peek Ptr Word
cnt'
[Word32]
arr <- [Int] -> (Int -> IO Word32) -> IO [Word32]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [0..Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
cnt_Int -> Int -> Int
forall a. Num a => a -> a -> a
-1] ((Int -> IO Word32) -> IO [Word32])
-> (Int -> IO Word32) -> IO [Word32]
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Int -> IO Word32
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word32
arr'
(Word, [String]) -> IO (Word, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Word
length, (Word32 -> String) -> [Word32] -> [String]
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
faceGlyphCount :: Face -> Word
faceGlyphCount :: Face -> Word
faceGlyphCount = (Ptr Face' -> Word) -> Face -> Word
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
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 ()
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 ()
faceCollectVarUnicodes :: Face -> Word32 -> [Word32]
faceCollectVarUnicodes :: Face -> Word32 -> [Word32]
faceCollectVarUnicodes fce :: Face
fce varSel :: Word32
varSel = ((Ptr Face' -> Set_ -> IO ()) -> Face -> [Word32]
faceCollectFunc Ptr Face' -> Set_ -> IO ()
inner) Face
fce
where inner :: Ptr Face' -> Set_ -> IO ()
inner a :: Ptr Face'
a b :: 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 ()
faceIndex :: Face -> Word
faceIndex :: Face -> Word
faceIndex = (Ptr Face' -> Word) -> Face -> Word
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
faceUpem :: Face -> Word
faceUpem :: Face -> Word
faceUpem = (Ptr Face' -> Word) -> Face -> Word
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
faceBlob :: Face -> ByteString
faceBlob :: Face -> ByteString
faceBlob = Ptr Blob' -> ByteString
blob2bs (Ptr Blob' -> ByteString)
-> (Face -> Ptr Blob') -> Face -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Face' -> Ptr Blob') -> Face -> Ptr Blob'
forall a. (Ptr Face' -> a) -> Face -> a
faceFunc Ptr Face' -> Ptr Blob'
hb_face_reference_blob
foreign import ccall "hb_face_reference_blob" hb_face_reference_blob :: Face_ -> Blob_
faceTable :: Face -> String -> ByteString
faceTable :: Face -> String -> ByteString
faceTable face :: Face
face tag :: String
tag = Ptr Blob' -> ByteString
blob2bs (Ptr Blob' -> ByteString) -> Ptr Blob' -> ByteString
forall a b. (a -> b) -> a -> b
$ IO (Ptr Blob') -> Ptr Blob'
forall a. IO a -> a
unsafePerformIO (IO (Ptr Blob') -> Ptr Blob') -> IO (Ptr Blob') -> Ptr Blob'
forall a b. (a -> b) -> a -> b
$ Face -> (Ptr Face' -> IO (Ptr Blob')) -> IO (Ptr Blob')
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
face ((Ptr Face' -> IO (Ptr Blob')) -> IO (Ptr Blob'))
-> (Ptr Face' -> IO (Ptr Blob')) -> IO (Ptr Blob')
forall a b. (a -> b) -> a -> b
$ \fce' :: Ptr Face'
fce' -> do
Ptr Face' -> Word32 -> IO (Ptr Blob')
hb_face_reference_table Ptr Face'
fce' (Word32 -> IO (Ptr Blob')) -> Word32 -> IO (Ptr Blob')
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_
data FaceOptions = FaceOptions {
FaceOptions -> Maybe Int
faceOptGlyphCount :: Maybe Int,
FaceOptions -> Maybe Word
faceOptIndex :: Maybe Word,
FaceOptions -> Maybe Word
faceOptUPEm :: Maybe Word
} deriving (ReadPrec [FaceOptions]
ReadPrec FaceOptions
Int -> ReadS FaceOptions
ReadS [FaceOptions]
(Int -> ReadS FaceOptions)
-> ReadS [FaceOptions]
-> ReadPrec FaceOptions
-> ReadPrec [FaceOptions]
-> Read 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
(Int -> FaceOptions -> ShowS)
-> (FaceOptions -> String)
-> ([FaceOptions] -> ShowS)
-> Show FaceOptions
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
Eq FaceOptions =>
(FaceOptions -> FaceOptions -> Ordering)
-> (FaceOptions -> FaceOptions -> Bool)
-> (FaceOptions -> FaceOptions -> Bool)
-> (FaceOptions -> FaceOptions -> Bool)
-> (FaceOptions -> FaceOptions -> Bool)
-> (FaceOptions -> FaceOptions -> FaceOptions)
-> (FaceOptions -> FaceOptions -> FaceOptions)
-> Ord 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
$cp1Ord :: Eq FaceOptions
Ord, FaceOptions -> FaceOptions -> Bool
(FaceOptions -> FaceOptions -> Bool)
-> (FaceOptions -> FaceOptions -> Bool) -> Eq FaceOptions
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)
defaultFaceOptions :: FaceOptions
defaultFaceOptions = Maybe Int -> Maybe Word -> Maybe Word -> FaceOptions
FaceOptions Maybe Int
forall a. Maybe a
Nothing Maybe Word
forall a. Maybe a
Nothing Maybe Word
forall a. Maybe a
Nothing
_setFaceOptions :: Ptr Face' -> FaceOptions -> IO ()
_setFaceOptions face :: Ptr Face'
face opts :: FaceOptions
opts = do
case FaceOptions -> Maybe Int
faceOptGlyphCount FaceOptions
opts of
Just x :: Int
x -> Ptr Face' -> Int -> IO ()
hb_face_set_glyph_count Ptr Face'
face Int
x
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case FaceOptions -> Maybe Word
faceOptIndex FaceOptions
opts of
Just x :: Word
x -> Ptr Face' -> Word -> IO ()
hb_face_set_index Ptr Face'
face Word
x
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case FaceOptions -> Maybe Word
faceOptUPEm FaceOptions
opts of
Just x :: Word
x -> Ptr Face' -> Word -> IO ()
hb_face_set_upem Ptr Face'
face Word
x
Nothing -> () -> IO ()
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 ()
createFaceWithOpts :: FaceOptions -> ByteString -> Word -> Face
createFaceWithOpts :: FaceOptions -> ByteString -> Word -> Face
createFaceWithOpts opts :: FaceOptions
opts bytes :: ByteString
bytes index :: Word
index = IO Face -> Face
forall a. IO a -> a
unsafePerformIO (IO Face -> Face) -> IO Face -> Face
forall a b. (a -> b) -> a -> b
$ do
Blob
blob <- ByteString -> IO Blob
bs2blob ByteString
bytes
Ptr Face'
face <- Blob -> (Ptr Blob' -> IO (Ptr Face')) -> IO (Ptr Face')
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Blob
blob ((Ptr Blob' -> IO (Ptr Face')) -> IO (Ptr Face'))
-> (Ptr Blob' -> IO (Ptr Face')) -> IO (Ptr Face')
forall a b. (a -> b) -> a -> b
$ IO (Ptr Face') -> IO (Ptr Face')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Face') -> IO (Ptr Face'))
-> (Ptr Blob' -> IO (Ptr Face')) -> Ptr Blob' -> IO (Ptr Face')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Blob' -> Word -> IO (Ptr Face'))
-> Word -> Ptr Blob' -> IO (Ptr Face')
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr 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
FinalizerPtr Face' -> Ptr Face' -> IO Face
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Face'
hb_face_destroy Ptr Face'
face
ftCreateFaceWithOpts :: FaceOptions -> FT_Face -> IO Face
ftCreateFaceWithOpts :: FaceOptions -> FT_Face -> IO Face
ftCreateFaceWithOpts opts :: FaceOptions
opts ftFace :: FT_Face
ftFace = do
Ptr Face'
face <- IO (Ptr Face') -> IO (Ptr Face')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Face') -> IO (Ptr Face'))
-> IO (Ptr Face') -> IO (Ptr Face')
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
FinalizerPtr Face' -> Ptr Face' -> IO Face
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Face'
hb_face_destroy Ptr Face'
face
buildFace :: [(String, ByteString)] -> FaceOptions -> Face
buildFace :: [(String, ByteString)] -> FaceOptions -> Face
buildFace tables :: [(String, ByteString)]
tables opts :: FaceOptions
opts = IO Face -> Face
forall a. IO a -> a
unsafePerformIO (IO Face -> Face) -> IO Face -> Face
forall a b. (a -> b) -> a -> b
$ do
Ptr Face'
builder <- IO (Ptr Face') -> IO (Ptr Face')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull IO (Ptr Face')
hb_face_builder_create
[(String, ByteString)]
-> ((String, ByteString) -> IO ()) -> IO [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, ByteString)]
tables (((String, ByteString) -> IO ()) -> IO [()])
-> ((String, ByteString) -> IO ()) -> IO [()]
forall a b. (a -> b) -> a -> b
$ \(tag :: String
tag, bytes :: ByteString
bytes) -> do
Blob
blob <- ByteString -> IO Blob
bs2blob ByteString
bytes
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Blob -> (Ptr Blob' -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Blob
blob ((Ptr Blob' -> IO Bool) -> IO Bool)
-> (Ptr Blob' -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
Ptr Face' -> Word32 -> Ptr Blob' -> IO Bool
hb_face_builder_add_table Ptr Face'
builder (Word32 -> Ptr Blob' -> IO Bool) -> Word32 -> Ptr Blob' -> IO Bool
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
FinalizerPtr Face' -> Ptr Face' -> IO Face
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Face'
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
type Font = ForeignPtr Font'
type Font_ = Ptr Font'
data Font'
createFont :: Face -> Font
createFont :: Face -> Font
createFont fce :: Face
fce = IO Font -> Font
forall a. IO a -> a
unsafePerformIO (IO Font -> Font) -> IO Font -> Font
forall a b. (a -> b) -> a -> b
$ do
Ptr Font'
font <- IO (Ptr Font') -> IO (Ptr Font')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Font') -> IO (Ptr Font'))
-> IO (Ptr Font') -> IO (Ptr Font')
forall a b. (a -> b) -> a -> b
$ Face -> (Ptr Face' -> IO (Ptr Font')) -> IO (Ptr Font')
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
fce ((Ptr Face' -> IO (Ptr Font')) -> IO (Ptr Font'))
-> (Ptr Face' -> IO (Ptr Font')) -> IO (Ptr Font')
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
FinalizerPtr Font' -> Ptr Font' -> IO Font
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Font'
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 ())
ftCreateFont :: FT_Face -> IO Font
ftCreateFont :: FT_Face -> IO Font
ftCreateFont fce :: FT_Face
fce = do
Ptr Font'
font <- IO (Ptr Font') -> IO (Ptr Font')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Font') -> IO (Ptr Font'))
-> IO (Ptr Font') -> IO (Ptr Font')
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
FinalizerPtr Font' -> Ptr Font' -> IO Font
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Font'
hb_font_destroy Ptr Font'
font
foreign import ccall "hb_ft_font_create_referenced" hb_ft_font_create_referenced
:: FT_Face -> IO Font_
createSubFont :: Font -> Font
createSubFont :: Font -> Font
createSubFont parent :: Font
parent = IO Font -> Font
forall a. IO a -> a
unsafePerformIO (IO Font -> Font) -> IO Font -> Font
forall a b. (a -> b) -> a -> b
$ do
Ptr Font'
font <- IO (Ptr Font') -> IO (Ptr Font')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Font') -> IO (Ptr Font'))
-> IO (Ptr Font') -> IO (Ptr Font')
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO (Ptr Font')) -> IO (Ptr Font')
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
parent ((Ptr Font' -> IO (Ptr Font')) -> IO (Ptr Font'))
-> (Ptr Font' -> IO (Ptr Font')) -> IO (Ptr Font')
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
FinalizerPtr Font' -> Ptr Font' -> IO Font
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Font'
hb_font_destroy Ptr Font'
font
foreign import ccall "hb_font_create_sub_font" hb_font_create_sub_font :: Font_ -> IO Font_
emptyFont :: Font
emptyFont :: Font
emptyFont = IO Font -> Font
forall a. IO a -> a
unsafePerformIO (IO Font -> Font) -> IO Font -> Font
forall a b. (a -> b) -> a -> b
$ FinalizerPtr Font' -> Ptr Font' -> IO Font
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Font'
hb_font_destroy Ptr Font'
hb_font_get_empty
foreign import ccall "hb_font_get_empty" hb_font_get_empty :: Font_
fontFace :: Font -> Face
fontFace :: Font -> Face
fontFace font :: Font
font = IO Face -> Face
forall a. IO a -> a
unsafePerformIO (IO Face -> Face) -> IO Face -> Face
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO Face) -> IO Face
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO Face) -> IO Face)
-> (Ptr Font' -> IO Face) -> IO Face
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> do
Ptr Face'
face' <- IO (Ptr Face') -> IO (Ptr Face')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Face') -> IO (Ptr Face'))
-> IO (Ptr Face') -> IO (Ptr Face')
forall a b. (a -> b) -> a -> b
$ Ptr Font' -> IO (Ptr Face')
hb_font_get_face Ptr Font'
font'
Ptr Face' -> IO Face
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Face'
face'
foreign import ccall "hb_font_get_face" hb_font_get_face :: Font_ -> IO Face_
fontGlyph :: Font -> Char -> Maybe Char -> Maybe Word32
fontGlyph :: Font -> Char -> Maybe Char -> Maybe Word32
fontGlyph font :: Font
font char :: Char
char var :: Maybe Char
var =
IO (Maybe Word32) -> Maybe Word32
forall a. IO a -> a
unsafePerformIO (IO (Maybe Word32) -> Maybe Word32)
-> IO (Maybe Word32) -> Maybe Word32
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32))
-> (Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32))
-> (Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ \ret :: 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 (Char -> Word32) -> Char -> Word32
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe '\0' Maybe Char
var) Ptr Word32
ret
if Bool
success then Maybe Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Word32 -> IO (Maybe Word32))
-> (Word32 -> Maybe Word32) -> Word32 -> IO (Maybe Word32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> IO (Maybe Word32)) -> IO Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
ret else Maybe Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word32
forall a. Maybe a
Nothing
fontGlyph' :: Font -> Char -> Maybe Char -> Word32
fontGlyph' font :: Font
font char :: Char
char var :: Maybe Char
var =
IO Word32 -> Word32
forall a. IO a -> a
unsafePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO Word32) -> IO Word32
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO Word32) -> IO Word32)
-> (Ptr Font' -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO Word32) -> IO Word32)
-> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \ret :: Ptr Word32
ret -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
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 (Char -> Word32) -> Char -> Word32
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe '\0' Maybe Char
var) Ptr Word32
ret
Ptr Word32 -> IO Word32
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
fontGlyphAdvance :: Font -> Word32 -> Maybe Direction -> (Int32, Int32)
fontGlyphAdvance :: Font -> Word32 -> Maybe Direction -> (Int32, Int32)
fontGlyphAdvance font :: Font
font glyph :: Word32
glyph dir :: Maybe Direction
dir = IO (Int32, Int32) -> (Int32, Int32)
forall a. IO a -> a
unsafePerformIO (IO (Int32, Int32) -> (Int32, Int32))
-> IO (Int32, Int32) -> (Int32, Int32)
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Int32
x' -> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \y' :: 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 (Maybe Direction -> Int
forall p. Num p => Maybe Direction -> p
dir2int Maybe Direction
dir) Ptr Int32
x' Ptr Int32
y'
Int32
x <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
(Int32, Int32) -> IO (Int32, Int32)
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 ()
fontGlyphContourPoint :: Font -> Word32 -> Int -> Maybe (Int32, Int32)
fontGlyphContourPoint :: Font -> Word32 -> Int -> Maybe (Int32, Int32)
fontGlyphContourPoint font :: Font
font glyph :: Word32
glyph index :: Int
index = IO (Maybe (Int32, Int32)) -> Maybe (Int32, Int32)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (Int32, Int32)) -> Maybe (Int32, Int32))
-> IO (Maybe (Int32, Int32)) -> Maybe (Int32, Int32)
forall a b. (a -> b) -> a -> b
$
Font
-> (Ptr Font' -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32)))
-> (Ptr Font' -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32)))
-> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Int32
x' -> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32)))
-> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ \y' :: 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 <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32)))
-> Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ (Int32, Int32) -> Maybe (Int32, Int32)
forall a. a -> Maybe a
Just (Int32
x, Int32
y)
else Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int32, Int32)
forall a. Maybe a
Nothing
fontGlyphContourPoint' :: Font -> Word32 -> Int -> (Int32, Int32)
fontGlyphContourPoint' font :: Font
font glyph :: Word32
glyph index :: Int
index = IO (Int32, Int32) -> (Int32, Int32)
forall a. IO a -> a
unsafePerformIO (IO (Int32, Int32) -> (Int32, Int32))
-> IO (Int32, Int32) -> (Int32, Int32)
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Int32
x' -> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \y' :: Ptr Int32
y' -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
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 <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
(Int32, Int32) -> IO (Int32, Int32)
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
fontGlyphContourPointForOrigin :: Font -> Word32 -> Int -> Maybe Direction -> Maybe (Int32, Int32)
fontGlyphContourPointForOrigin :: Font -> Word32 -> Int -> Maybe Direction -> Maybe (Int32, Int32)
fontGlyphContourPointForOrigin font :: Font
font glyph :: Word32
glyph index :: Int
index dir :: Maybe Direction
dir = IO (Maybe (Int32, Int32)) -> Maybe (Int32, Int32)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (Int32, Int32)) -> Maybe (Int32, Int32))
-> IO (Maybe (Int32, Int32)) -> Maybe (Int32, Int32)
forall a b. (a -> b) -> a -> b
$
Font
-> (Ptr Font' -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32)))
-> (Ptr Font' -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32)))
-> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Int32
x' -> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32)))
-> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ \y' :: 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
(Maybe Direction -> Int
forall p. Num p => Maybe Direction -> p
dir2int Maybe Direction
dir) Ptr Int32
x' Ptr Int32
y'
if Bool
success
then do
Int32
x <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32)))
-> Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ (Int32, Int32) -> Maybe (Int32, Int32)
forall a. a -> Maybe a
Just (Int32
x, Int32
y)
else Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int32, Int32)
forall a. Maybe a
Nothing
fontGlyphContourPointForOrigin' :: Font -> Word32 -> Int -> Maybe Direction -> (Int32, Int32)
fontGlyphContourPointForOrigin' font :: Font
font glyph :: Word32
glyph index :: Int
index dir :: Maybe Direction
dir = IO (Int32, Int32) -> (Int32, Int32)
forall a. IO a -> a
unsafePerformIO (IO (Int32, Int32) -> (Int32, Int32))
-> IO (Int32, Int32) -> (Int32, Int32)
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Int32
x' -> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \y' :: Ptr Int32
y' -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
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
(Maybe Direction -> Int
forall p. Num p => Maybe Direction -> p
dir2int Maybe Direction
dir) Ptr Int32
x' Ptr Int32
y'
Int32
x <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
(Int32, Int32) -> IO (Int32, Int32)
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
data GlyphExtents = GlyphExtents {
GlyphExtents -> Word32
xBearing :: Word32,
GlyphExtents -> Word32
yBearing :: Word32,
GlyphExtents -> Word32
width :: Word32,
GlyphExtents -> Word32
height :: Word32
} deriving ((forall x. GlyphExtents -> Rep GlyphExtents x)
-> (forall x. Rep GlyphExtents x -> GlyphExtents)
-> Generic GlyphExtents
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]
(Int -> ReadS GlyphExtents)
-> ReadS [GlyphExtents]
-> ReadPrec GlyphExtents
-> ReadPrec [GlyphExtents]
-> Read 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
(Int -> GlyphExtents -> ShowS)
-> (GlyphExtents -> String)
-> ([GlyphExtents] -> ShowS)
-> Show GlyphExtents
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
Eq GlyphExtents =>
(GlyphExtents -> GlyphExtents -> Ordering)
-> (GlyphExtents -> GlyphExtents -> Bool)
-> (GlyphExtents -> GlyphExtents -> Bool)
-> (GlyphExtents -> GlyphExtents -> Bool)
-> (GlyphExtents -> GlyphExtents -> Bool)
-> (GlyphExtents -> GlyphExtents -> GlyphExtents)
-> (GlyphExtents -> GlyphExtents -> GlyphExtents)
-> Ord 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
$cp1Ord :: Eq GlyphExtents
Ord, GlyphExtents -> GlyphExtents -> Bool
(GlyphExtents -> GlyphExtents -> Bool)
-> (GlyphExtents -> GlyphExtents -> Bool) -> Eq GlyphExtents
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
fontGlyphExtents :: Font -> Word32 -> Maybe GlyphExtents
fontGlyphExtents :: Font -> Word32 -> Maybe GlyphExtents
fontGlyphExtents font :: Font
font glyph :: Word32
glyph = IO (Maybe GlyphExtents) -> Maybe GlyphExtents
forall a. IO a -> a
unsafePerformIO (IO (Maybe GlyphExtents) -> Maybe GlyphExtents)
-> IO (Maybe GlyphExtents) -> Maybe GlyphExtents
forall a b. (a -> b) -> a -> b
$
Font
-> (Ptr Font' -> IO (Maybe GlyphExtents))
-> IO (Maybe GlyphExtents)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Maybe GlyphExtents)) -> IO (Maybe GlyphExtents))
-> (Ptr Font' -> IO (Maybe GlyphExtents))
-> IO (Maybe GlyphExtents)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr GlyphExtents -> IO (Maybe GlyphExtents))
-> IO (Maybe GlyphExtents)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GlyphExtents -> IO (Maybe GlyphExtents))
-> IO (Maybe GlyphExtents))
-> (Ptr GlyphExtents -> IO (Maybe GlyphExtents))
-> IO (Maybe GlyphExtents)
forall a b. (a -> b) -> a -> b
$ \ret :: 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 Maybe GlyphExtents -> IO (Maybe GlyphExtents)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlyphExtents -> IO (Maybe GlyphExtents))
-> (GlyphExtents -> Maybe GlyphExtents)
-> GlyphExtents
-> IO (Maybe GlyphExtents)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlyphExtents -> Maybe GlyphExtents
forall a. a -> Maybe a
Just (GlyphExtents -> IO (Maybe GlyphExtents))
-> IO GlyphExtents -> IO (Maybe GlyphExtents)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr GlyphExtents -> IO GlyphExtents
forall a. Storable a => Ptr a -> IO a
peek Ptr GlyphExtents
ret
else Maybe GlyphExtents -> IO (Maybe GlyphExtents)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlyphExtents
forall a. Maybe a
Nothing
fontGlyphExtents' :: Font -> Word32 -> GlyphExtents
fontGlyphExtents' font :: Font
font glyph :: Word32
glyph = IO GlyphExtents -> GlyphExtents
forall a. IO a -> a
unsafePerformIO (IO GlyphExtents -> GlyphExtents)
-> IO GlyphExtents -> GlyphExtents
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO GlyphExtents) -> IO GlyphExtents
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO GlyphExtents) -> IO GlyphExtents)
-> (Ptr Font' -> IO GlyphExtents) -> IO GlyphExtents
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr GlyphExtents -> IO GlyphExtents) -> IO GlyphExtents
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GlyphExtents -> IO GlyphExtents) -> IO GlyphExtents)
-> (Ptr GlyphExtents -> IO GlyphExtents) -> IO GlyphExtents
forall a b. (a -> b) -> a -> b
$ \ret :: Ptr GlyphExtents
ret -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
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
Ptr GlyphExtents -> IO GlyphExtents
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
fontGlyphExtentsForOrigin :: Font -> Word32 -> Maybe Direction -> Maybe GlyphExtents
fontGlyphExtentsForOrigin :: Font -> Word32 -> Maybe Direction -> Maybe GlyphExtents
fontGlyphExtentsForOrigin font :: Font
font glyph :: Word32
glyph dir :: Maybe Direction
dir = IO (Maybe GlyphExtents) -> Maybe GlyphExtents
forall a. IO a -> a
unsafePerformIO (IO (Maybe GlyphExtents) -> Maybe GlyphExtents)
-> IO (Maybe GlyphExtents) -> Maybe GlyphExtents
forall a b. (a -> b) -> a -> b
$
Font
-> (Ptr Font' -> IO (Maybe GlyphExtents))
-> IO (Maybe GlyphExtents)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Maybe GlyphExtents)) -> IO (Maybe GlyphExtents))
-> (Ptr Font' -> IO (Maybe GlyphExtents))
-> IO (Maybe GlyphExtents)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr GlyphExtents -> IO (Maybe GlyphExtents))
-> IO (Maybe GlyphExtents)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GlyphExtents -> IO (Maybe GlyphExtents))
-> IO (Maybe GlyphExtents))
-> (Ptr GlyphExtents -> IO (Maybe GlyphExtents))
-> IO (Maybe GlyphExtents)
forall a b. (a -> b) -> a -> b
$ \ret :: 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 (Maybe Direction -> Int
forall p. Num p => Maybe Direction -> p
dir2int Maybe Direction
dir) Ptr GlyphExtents
ret
if Bool
ok
then Maybe GlyphExtents -> IO (Maybe GlyphExtents)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlyphExtents -> IO (Maybe GlyphExtents))
-> (GlyphExtents -> Maybe GlyphExtents)
-> GlyphExtents
-> IO (Maybe GlyphExtents)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlyphExtents -> Maybe GlyphExtents
forall a. a -> Maybe a
Just (GlyphExtents -> IO (Maybe GlyphExtents))
-> IO GlyphExtents -> IO (Maybe GlyphExtents)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr GlyphExtents -> IO GlyphExtents
forall a. Storable a => Ptr a -> IO a
peek Ptr GlyphExtents
ret
else Maybe GlyphExtents -> IO (Maybe GlyphExtents)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlyphExtents
forall a. Maybe a
Nothing
fontGlyphExtentsForOrigin' :: Font -> Word32 -> Maybe Direction -> GlyphExtents
fontGlyphExtentsForOrigin' font :: Font
font glyph :: Word32
glyph dir :: Maybe Direction
dir = IO GlyphExtents -> GlyphExtents
forall a. IO a -> a
unsafePerformIO (IO GlyphExtents -> GlyphExtents)
-> IO GlyphExtents -> GlyphExtents
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO GlyphExtents) -> IO GlyphExtents
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO GlyphExtents) -> IO GlyphExtents)
-> (Ptr Font' -> IO GlyphExtents) -> IO GlyphExtents
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr GlyphExtents -> IO GlyphExtents) -> IO GlyphExtents
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GlyphExtents -> IO GlyphExtents) -> IO GlyphExtents)
-> (Ptr GlyphExtents -> IO GlyphExtents) -> IO GlyphExtents
forall a b. (a -> b) -> a -> b
$ \ret :: Ptr GlyphExtents
ret -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
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 (Maybe Direction -> Int
forall p. Num p => Maybe Direction -> p
dir2int Maybe Direction
dir) Ptr GlyphExtents
ret
Ptr GlyphExtents -> IO GlyphExtents
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
fontGlyphFromName :: Font -> String -> Maybe Word32
fontGlyphFromName :: Font -> String -> Maybe Word32
fontGlyphFromName font :: Font
font name :: String
name = IO (Maybe Word32) -> Maybe Word32
forall a. IO a -> a
unsafePerformIO (IO (Maybe Word32) -> Maybe Word32)
-> IO (Maybe Word32) -> Maybe Word32
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32))
-> (Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32))
-> (Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ \ret :: Ptr Word32
ret -> do
Bool
success <- String -> (CStringLen -> IO Bool) -> IO Bool
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
name ((CStringLen -> IO Bool) -> IO Bool)
-> (CStringLen -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \(name' :: Ptr CChar
name', len :: 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 Maybe Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Word32 -> IO (Maybe Word32))
-> (Word32 -> Maybe Word32) -> Word32 -> IO (Maybe Word32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> IO (Maybe Word32)) -> IO Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
ret
else Maybe Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word32
forall a. Maybe a
Nothing
fontGlyphFromName' :: Font -> String -> Word32
fontGlyphFromName' font :: Font
font name :: String
name = IO Word32 -> Word32
forall a. IO a -> a
unsafePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO Word32) -> IO Word32
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO Word32) -> IO Word32)
-> (Ptr Font' -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO Word32) -> IO Word32)
-> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \ret :: Ptr Word32
ret -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (CStringLen -> IO Bool) -> IO Bool
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
name ((CStringLen -> IO Bool) -> IO Bool)
-> (CStringLen -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \(name' :: Ptr CChar
name', len :: 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
Ptr Word32 -> IO Word32
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
fontGlyphHAdvance :: Font -> Word32 -> Int32
fontGlyphHAdvance :: Font -> Word32 -> Int32
fontGlyphHAdvance = (Ptr Font' -> Word32 -> Int32) -> Font -> Word32 -> Int32
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
fontGlyphVAdvance :: Font -> Word32 -> Int32
fontGlyphVAdvance :: Font -> Word32 -> Int32
fontGlyphVAdvance = (Ptr Font' -> Word32 -> Int32) -> Font -> Word32 -> Int32
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
fontGlyphHKerning :: Font -> Word32 -> Word32 -> Int32
fontGlyphHKerning :: Font -> Word32 -> Word32 -> Int32
fontGlyphHKerning = (Ptr Font' -> Word32 -> Word32 -> Int32)
-> Font -> Word32 -> Word32 -> Int32
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
fontGlyphHOrigin :: Font -> Word32 -> Maybe (Int32, Int32)
fontGlyphHOrigin :: Font -> Word32 -> Maybe (Int32, Int32)
fontGlyphHOrigin font :: Font
font glyph :: Word32
glyph = IO (Maybe (Int32, Int32)) -> Maybe (Int32, Int32)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (Int32, Int32)) -> Maybe (Int32, Int32))
-> IO (Maybe (Int32, Int32)) -> Maybe (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ Font
-> (Ptr Font' -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32)))
-> (Ptr Font' -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' ->
(Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32)))
-> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Int32
x' -> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32)))
-> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ \y' :: 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 <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32)))
-> Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ (Int32, Int32) -> Maybe (Int32, Int32)
forall a. a -> Maybe a
Just (Int32
x, Int32
y)
else Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int32, Int32)
forall a. Maybe a
Nothing
fontGlyphHOrigin' :: Font -> Word32 -> (Int32, Int32)
fontGlyphHOrigin' font :: Font
font glyph :: Word32
glyph = IO (Int32, Int32) -> (Int32, Int32)
forall a. IO a -> a
unsafePerformIO (IO (Int32, Int32) -> (Int32, Int32))
-> IO (Int32, Int32) -> (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' ->
(Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Int32
x' -> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \y' :: Ptr Int32
y' -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
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 <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
(Int32, Int32) -> IO (Int32, Int32)
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
fontGlyphVOrigin :: Font -> Word32 -> Maybe (Int32, Int32)
fontGlyphVOrigin :: Font -> Word32 -> Maybe (Int32, Int32)
fontGlyphVOrigin font :: Font
font glyph :: Word32
glyph = IO (Maybe (Int32, Int32)) -> Maybe (Int32, Int32)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (Int32, Int32)) -> Maybe (Int32, Int32))
-> IO (Maybe (Int32, Int32)) -> Maybe (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ Font
-> (Ptr Font' -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32)))
-> (Ptr Font' -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' ->
(Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32)))
-> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Int32
x' -> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32)))
-> (Ptr Int32 -> IO (Maybe (Int32, Int32)))
-> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ \y' :: 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 <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32)))
-> Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32))
forall a b. (a -> b) -> a -> b
$ (Int32, Int32) -> Maybe (Int32, Int32)
forall a. a -> Maybe a
Just (Int32
x, Int32
y)
else Maybe (Int32, Int32) -> IO (Maybe (Int32, Int32))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int32, Int32)
forall a. Maybe a
Nothing
fontGlyphVOrigin' :: Font -> Word32 -> (Int32, Int32)
fontGlyphVOrigin' font :: Font
font glyph :: Word32
glyph = IO (Int32, Int32) -> (Int32, Int32)
forall a. IO a -> a
unsafePerformIO (IO (Int32, Int32) -> (Int32, Int32))
-> IO (Int32, Int32) -> (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' ->
(Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Int32
x' -> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \y' :: Ptr Int32
y' -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
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 <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
(Int32, Int32) -> IO (Int32, Int32)
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
fontGlyphKerningForDir :: Font -> Word32 -> Word32 -> Maybe Direction -> (Int32, Int32)
fontGlyphKerningForDir :: Font -> Word32 -> Word32 -> Maybe Direction -> (Int32, Int32)
fontGlyphKerningForDir font :: Font
font a :: Word32
a b :: Word32
b dir :: Maybe Direction
dir = IO (Int32, Int32) -> (Int32, Int32)
forall a. IO a -> a
unsafePerformIO (IO (Int32, Int32) -> (Int32, Int32))
-> IO (Int32, Int32) -> (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' ->
(Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Int32
x' -> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \y' :: 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 (Maybe Direction -> Int
forall p. Num p => Maybe Direction -> p
dir2int Maybe Direction
dir) Ptr Int32
x' Ptr Int32
y'
Int32
x <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
(Int32, Int32) -> IO (Int32, Int32)
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 ()
fontGlyphName :: Font -> Word32 -> Maybe String
fontGlyphName :: Font -> Word32 -> Maybe String
fontGlyphName a :: Font
a b :: Word32
b = Font -> Word32 -> Int -> Maybe String
fontGlyphName_ Font
a Word32
b 32
fontGlyphName' :: Font -> Word32 -> String
fontGlyphName' a :: Font
a b :: Word32
b = Font -> Word32 -> Int -> String
fontGlyphName_' Font
a Word32
b 32
fontGlyphName_ :: Font -> Word32 -> Int -> Maybe String
fontGlyphName_ :: Font -> Word32 -> Int -> Maybe String
fontGlyphName_ font :: Font
font glyph :: Word32
glyph size :: Int
size = IO (Maybe String) -> Maybe String
forall a. IO a -> a
unsafePerformIO (IO (Maybe String) -> Maybe String)
-> IO (Maybe String) -> Maybe String
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO (Maybe String)) -> IO (Maybe String)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Maybe String)) -> IO (Maybe String))
-> (Ptr Font' -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' ->
Int -> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
size ((Ptr CChar -> IO (Maybe String)) -> IO (Maybe String))
-> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \name' :: 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' (Int -> Word32
forall a. Enum a => Int -> a
toEnum Int
size)
if Bool
success
then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO String
peekCStringLen (Ptr CChar
name', Int
size)
else Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
fontGlyphName_' :: Font -> Word32 -> Int -> String
fontGlyphName_' font :: Font
font glyph :: Word32
glyph size :: Int
size = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO String) -> IO String
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO String) -> IO String)
-> (Ptr Font' -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' ->
Int -> (Ptr CChar -> IO String) -> IO String
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
size ((Ptr CChar -> IO String) -> IO String)
-> (Ptr CChar -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \name' :: Ptr CChar
name' -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
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' (Int -> Word32
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
fontGlyphOriginForDir :: Font -> Word32 -> Maybe Direction -> (Int32, Int32)
fontGlyphOriginForDir :: Font -> Word32 -> Maybe Direction -> (Int32, Int32)
fontGlyphOriginForDir font :: Font
font glyph :: Word32
glyph dir :: Maybe Direction
dir = IO (Int32, Int32) -> (Int32, Int32)
forall a. IO a -> a
unsafePerformIO (IO (Int32, Int32) -> (Int32, Int32))
-> IO (Int32, Int32) -> (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Font' -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' ->
(Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Int32
x' -> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32))
-> (Ptr Int32 -> IO (Int32, Int32)) -> IO (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ \y' :: 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 (Maybe Direction -> Int
forall p. Num p => Maybe Direction -> p
dir2int Maybe Direction
dir) Ptr Int32
x' Ptr Int32
y'
Int32
x <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x'
Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y'
(Int32, Int32) -> IO (Int32, Int32)
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 ()
fontNominalGlyph :: Font -> Char -> Maybe Word32
fontNominalGlyph :: Font -> Char -> Maybe Word32
fontNominalGlyph font :: Font
font c :: Char
c =
IO (Maybe Word32) -> Maybe Word32
forall a. IO a -> a
unsafePerformIO (IO (Maybe Word32) -> Maybe Word32)
-> IO (Maybe Word32) -> Maybe Word32
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32))
-> (Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32))
-> (Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ \glyph' :: 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 Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> IO Word32 -> IO (Maybe Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
glyph' else Maybe Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word32
forall a. Maybe a
Nothing
fontNominalGlyph' :: Font -> Char -> Word32
fontNominalGlyph' font :: Font
font c :: Char
c =
IO Word32 -> Word32
forall a. IO a -> a
unsafePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO Word32) -> IO Word32
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO Word32) -> IO Word32)
-> (Ptr Font' -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO Word32) -> IO Word32)
-> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \glyph' :: Ptr Word32
glyph' -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
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'
Ptr Word32 -> IO Word32
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
fontParent :: Font -> Font
fontParent :: Font -> Font
fontParent child :: Font
child =
IO Font -> Font
forall a. IO a -> a
unsafePerformIO (Ptr Font' -> IO Font
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ (Ptr Font' -> IO Font) -> IO (Ptr Font') -> IO Font
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Font -> (Ptr Font' -> IO (Ptr Font')) -> IO (Ptr Font')
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_
fontPPEm :: Font -> (Word32, Word32)
fontPPEm :: Font -> (Word32, Word32)
fontPPEm font :: Font
font =
IO (Word32, Word32) -> (Word32, Word32)
forall a. IO a -> a
unsafePerformIO (IO (Word32, Word32) -> (Word32, Word32))
-> IO (Word32, Word32) -> (Word32, Word32)
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO (Word32, Word32)) -> IO (Word32, Word32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Word32, Word32)) -> IO (Word32, Word32))
-> (Ptr Font' -> IO (Word32, Word32)) -> IO (Word32, Word32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word32 -> IO (Word32, Word32)) -> IO (Word32, Word32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO (Word32, Word32)) -> IO (Word32, Word32))
-> (Ptr Word32 -> IO (Word32, Word32)) -> IO (Word32, Word32)
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Word32
x' -> (Ptr Word32 -> IO (Word32, Word32)) -> IO (Word32, Word32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO (Word32, Word32)) -> IO (Word32, Word32))
-> (Ptr Word32 -> IO (Word32, Word32)) -> IO (Word32, Word32)
forall a b. (a -> b) -> a -> b
$ \y' :: 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 <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
x'
Word32
y <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
y'
(Word32, Word32) -> IO (Word32, Word32)
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 ()
fontPtEm :: Font -> Float
fontPtEm :: Font -> Float
fontPtEm = (Ptr Font' -> Float) -> Font -> Float
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
fontScale :: Font -> (Int, Int)
fontScale :: Font -> (Int, Int)
fontScale font :: Font
font = IO (Int, Int) -> (Int, Int)
forall a. IO a -> a
unsafePerformIO (IO (Int, Int) -> (Int, Int)) -> IO (Int, Int) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO (Int, Int)) -> IO (Int, Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr Font' -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Int32 -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr Int32 -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \x' :: Ptr Int32
x' -> (Ptr Int32 -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int32 -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr Int32 -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \y' :: 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 <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
x' :: IO Int32
Int32
y <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
y' :: IO Int32
(Int, Int) -> IO (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Int
forall a. Enum a => a -> Int
fromEnum Int32
x, Int32 -> Int
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 ()
fontSyntheticSlant :: Font -> Float
fontSyntheticSlant :: Font -> Float
fontSyntheticSlant = (Ptr Font' -> Float) -> Font -> Float
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
fontVarGlyph :: Font -> Word32 -> Word32 -> Maybe Word32
fontVarGlyph :: Font -> Word32 -> Word32 -> Maybe Word32
fontVarGlyph font :: Font
font unicode :: Word32
unicode varSel :: Word32
varSel = IO (Maybe Word32) -> Maybe Word32
forall a. IO a -> a
unsafePerformIO (IO (Maybe Word32) -> Maybe Word32)
-> IO (Maybe Word32) -> Maybe Word32
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32))
-> (Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32))
-> (Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ \glyph' :: 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 Maybe Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Word32 -> IO (Maybe Word32))
-> (Word32 -> Maybe Word32) -> Word32 -> IO (Maybe Word32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> IO (Maybe Word32)) -> IO Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
glyph'
else Maybe Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word32
forall a. Maybe a
Nothing
fontVarGlyph' :: Font -> Word32 -> Word32 -> Word32
fontVarGlyph' font :: Font
font unicode :: Word32
unicode varSel :: Word32
varSel = IO Word32 -> Word32
forall a. IO a -> a
unsafePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO Word32) -> IO Word32
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO Word32) -> IO Word32)
-> (Ptr Font' -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO Word32) -> IO Word32)
-> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \glyph' :: Ptr Word32
glyph' -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
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'
Ptr Word32 -> IO Word32
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
fontVarCoordsDesign :: Font -> [Float]
fontVarCoordsDesign :: Font -> [Float]
fontVarCoordsDesign font :: Font
font = IO [Float] -> [Float]
forall a. IO a -> a
unsafePerformIO (IO [Float] -> [Float]) -> IO [Float] -> [Float]
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO [Float]) -> IO [Float]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO [Float]) -> IO [Float])
-> (Ptr Font' -> IO [Float]) -> IO [Float]
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word -> IO [Float]) -> IO [Float]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word -> IO [Float]) -> IO [Float])
-> (Ptr Word -> IO [Float]) -> IO [Float]
forall a b. (a -> b) -> a -> b
$ \length' :: 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 <- Ptr Word -> IO Word
forall a. Storable a => Ptr a -> IO a
peek Ptr Word
length'
[Int] -> (Int -> IO Float) -> IO [Float]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [0..Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
lengthInt -> Int -> Int
forall a. Num a => a -> a -> a
-1] ((Int -> IO Float) -> IO [Float])
-> (Int -> IO Float) -> IO [Float]
forall a b. (a -> b) -> a -> b
$ Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
arr
foreign import ccall "hb_font_get_var_coords_design"
hb_font_get_var_coords_design :: Font_ -> Ptr Word -> IO (Ptr Float)
fontVarCoordsNormalized :: Font -> [Int]
fontVarCoordsNormalized :: Font -> [Int]
fontVarCoordsNormalized font :: Font
font = IO [Int] -> [Int]
forall a. IO a -> a
unsafePerformIO (IO [Int] -> [Int]) -> IO [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO [Int]) -> IO [Int]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO [Int]) -> IO [Int])
-> (Ptr Font' -> IO [Int]) -> IO [Int]
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word -> IO [Int]) -> IO [Int]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word -> IO [Int]) -> IO [Int])
-> (Ptr Word -> IO [Int]) -> IO [Int]
forall a b. (a -> b) -> a -> b
$ \length' :: Ptr Word
length' -> do
Ptr Int
arr <- IO (Ptr Int) -> IO (Ptr Int)
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Int) -> IO (Ptr Int)) -> IO (Ptr Int) -> IO (Ptr Int)
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 <- Ptr Word -> IO Word
forall a. Storable a => Ptr a -> IO a
peek Ptr Word
length'
[Int] -> (Int -> IO Int) -> IO [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [0..Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
lengthInt -> Int -> Int
forall a. Num a => a -> a -> a
-1] ((Int -> IO Int) -> IO [Int]) -> (Int -> IO Int) -> IO [Int]
forall a b. (a -> b) -> a -> b
$ Ptr Int -> Int -> IO Int
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)
fontTxt2Glyph :: Font -> String -> Maybe Word32
fontTxt2Glyph :: Font -> String -> Maybe Word32
fontTxt2Glyph font :: Font
font str :: String
str = IO (Maybe Word32) -> Maybe Word32
forall a. IO a -> a
unsafePerformIO (IO (Maybe Word32) -> Maybe Word32)
-> IO (Maybe Word32) -> Maybe Word32
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32))
-> (Ptr Font' -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32))
-> (Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ \ret :: Ptr Word32
ret -> do
Bool
ok <- String -> (CStringLen -> IO Bool) -> IO Bool
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str ((CStringLen -> IO Bool) -> IO Bool)
-> (CStringLen -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \(str' :: Ptr CChar
str', len :: 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 Maybe Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Word32 -> IO (Maybe Word32))
-> (Word32 -> Maybe Word32) -> Word32 -> IO (Maybe Word32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> IO (Maybe Word32)) -> IO Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
ret
else Maybe Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word32
forall a. Maybe a
Nothing
fontTxt2Glyph' :: Font -> String -> Word32
fontTxt2Glyph' font :: Font
font str :: String
str = IO Word32 -> Word32
forall a. IO a -> a
unsafePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO Word32) -> IO Word32
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO Word32) -> IO Word32)
-> (Ptr Font' -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO Word32) -> IO Word32)
-> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \ret :: Ptr Word32
ret -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (CStringLen -> IO Bool) -> IO Bool
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str ((CStringLen -> IO Bool) -> IO Bool)
-> (CStringLen -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \(str' :: Ptr CChar
str', len :: 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
Ptr Word32 -> IO Word32
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
fontGlyph2Str :: Font -> Word32 -> Int -> String
fontGlyph2Str :: Font -> Word32 -> Int -> String
fontGlyph2Str font :: Font
font glyph :: Word32
glyph length :: Int
length = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$
Font -> (Ptr Font' -> IO String) -> IO String
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO String) -> IO String)
-> (Ptr Font' -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> Int -> (Ptr CChar -> IO String) -> IO String
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
length ((Ptr CChar -> IO String) -> IO String)
-> (Ptr CChar -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \ret :: 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 ()
data FontExtents = FontExtents {
FontExtents -> Int32
ascender :: Int32,
FontExtents -> Int32
descender :: Int32,
FontExtents -> Int32
lineGap :: Int32
} deriving ((forall x. FontExtents -> Rep FontExtents x)
-> (forall x. Rep FontExtents x -> FontExtents)
-> Generic FontExtents
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]
(Int -> ReadS FontExtents)
-> ReadS [FontExtents]
-> ReadPrec FontExtents
-> ReadPrec [FontExtents]
-> Read 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
(Int -> FontExtents -> ShowS)
-> (FontExtents -> String)
-> ([FontExtents] -> ShowS)
-> Show FontExtents
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
Eq FontExtents =>
(FontExtents -> FontExtents -> Ordering)
-> (FontExtents -> FontExtents -> Bool)
-> (FontExtents -> FontExtents -> Bool)
-> (FontExtents -> FontExtents -> Bool)
-> (FontExtents -> FontExtents -> Bool)
-> (FontExtents -> FontExtents -> FontExtents)
-> (FontExtents -> FontExtents -> FontExtents)
-> Ord 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
$cp1Ord :: Eq FontExtents
Ord, FontExtents -> FontExtents -> Bool
(FontExtents -> FontExtents -> Bool)
-> (FontExtents -> FontExtents -> Bool) -> Eq FontExtents
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
fontExtentsForDir :: Font -> Maybe Direction -> FontExtents
fontExtentsForDir :: Font -> Maybe Direction -> FontExtents
fontExtentsForDir font :: Font
font dir :: Maybe Direction
dir = IO FontExtents -> FontExtents
forall a. IO a -> a
unsafePerformIO (IO FontExtents -> FontExtents) -> IO FontExtents -> FontExtents
forall a b. (a -> b) -> a -> b
$ (Ptr FontExtents -> IO FontExtents) -> IO FontExtents
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr FontExtents -> IO FontExtents) -> IO FontExtents)
-> (Ptr FontExtents -> IO FontExtents) -> IO FontExtents
forall a b. (a -> b) -> a -> b
$ \ret :: Ptr FontExtents
ret -> do
Font -> (Ptr Font' -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO ()) -> IO ()) -> (Ptr Font' -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' ->
Ptr Font' -> Int -> Ptr FontExtents -> IO ()
hb_font_get_extents_for_direction Ptr Font'
font' (Maybe Direction -> Int
forall p. Num p => Maybe Direction -> p
dir2int Maybe Direction
dir) Ptr FontExtents
ret
Ptr FontExtents -> IO FontExtents
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 ()
fontHExtents :: Font -> Maybe FontExtents
fontHExtents font :: Font
font = IO (Maybe FontExtents) -> Maybe FontExtents
forall a. IO a -> a
unsafePerformIO (IO (Maybe FontExtents) -> Maybe FontExtents)
-> IO (Maybe FontExtents) -> Maybe FontExtents
forall a b. (a -> b) -> a -> b
$ (Ptr FontExtents -> IO (Maybe FontExtents))
-> IO (Maybe FontExtents)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr FontExtents -> IO (Maybe FontExtents))
-> IO (Maybe FontExtents))
-> (Ptr FontExtents -> IO (Maybe FontExtents))
-> IO (Maybe FontExtents)
forall a b. (a -> b) -> a -> b
$ \ret :: Ptr FontExtents
ret -> do
Bool
ok <- Font -> (Ptr Font' -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO Bool) -> IO Bool)
-> (Ptr Font' -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> Ptr Font' -> Ptr FontExtents -> IO Bool
hb_font_get_h_extents Ptr Font'
font' Ptr FontExtents
ret
if Bool
ok
then Maybe FontExtents -> IO (Maybe FontExtents)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FontExtents -> IO (Maybe FontExtents))
-> (FontExtents -> Maybe FontExtents)
-> FontExtents
-> IO (Maybe FontExtents)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontExtents -> Maybe FontExtents
forall a. a -> Maybe a
Just (FontExtents -> IO (Maybe FontExtents))
-> IO FontExtents -> IO (Maybe FontExtents)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr FontExtents -> IO FontExtents
forall a. Storable a => Ptr a -> IO a
peek Ptr FontExtents
ret
else Maybe FontExtents -> IO (Maybe FontExtents)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontExtents
forall a. Maybe a
Nothing
fontHExtents' :: Font -> FontExtents
fontHExtents' font :: Font
font = IO FontExtents -> FontExtents
forall a. IO a -> a
unsafePerformIO (IO FontExtents -> FontExtents) -> IO FontExtents -> FontExtents
forall a b. (a -> b) -> a -> b
$ (Ptr FontExtents -> IO FontExtents) -> IO FontExtents
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr FontExtents -> IO FontExtents) -> IO FontExtents)
-> (Ptr FontExtents -> IO FontExtents) -> IO FontExtents
forall a b. (a -> b) -> a -> b
$ \ret :: Ptr FontExtents
ret -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO Bool) -> IO Bool)
-> (Ptr Font' -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> Ptr Font' -> Ptr FontExtents -> IO Bool
hb_font_get_h_extents Ptr Font'
font' Ptr FontExtents
ret
Ptr FontExtents -> IO FontExtents
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
fontVExtents :: Font -> Maybe FontExtents
fontVExtents font :: Font
font = IO (Maybe FontExtents) -> Maybe FontExtents
forall a. IO a -> a
unsafePerformIO (IO (Maybe FontExtents) -> Maybe FontExtents)
-> IO (Maybe FontExtents) -> Maybe FontExtents
forall a b. (a -> b) -> a -> b
$ (Ptr FontExtents -> IO (Maybe FontExtents))
-> IO (Maybe FontExtents)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr FontExtents -> IO (Maybe FontExtents))
-> IO (Maybe FontExtents))
-> (Ptr FontExtents -> IO (Maybe FontExtents))
-> IO (Maybe FontExtents)
forall a b. (a -> b) -> a -> b
$ \ret :: Ptr FontExtents
ret -> do
Bool
ok <- Font -> (Ptr Font' -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO Bool) -> IO Bool)
-> (Ptr Font' -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> Ptr Font' -> Ptr FontExtents -> IO Bool
hb_font_get_v_extents Ptr Font'
font' Ptr FontExtents
ret
if Bool
ok
then Maybe FontExtents -> IO (Maybe FontExtents)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FontExtents -> IO (Maybe FontExtents))
-> (FontExtents -> Maybe FontExtents)
-> FontExtents
-> IO (Maybe FontExtents)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontExtents -> Maybe FontExtents
forall a. a -> Maybe a
Just (FontExtents -> IO (Maybe FontExtents))
-> IO FontExtents -> IO (Maybe FontExtents)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr FontExtents -> IO FontExtents
forall a. Storable a => Ptr a -> IO a
peek Ptr FontExtents
ret
else Maybe FontExtents -> IO (Maybe FontExtents)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FontExtents
forall a. Maybe a
Nothing
fontVExtents' :: Font -> FontExtents
fontVExtents' font :: Font
font = IO FontExtents -> FontExtents
forall a. IO a -> a
unsafePerformIO (IO FontExtents -> FontExtents) -> IO FontExtents -> FontExtents
forall a b. (a -> b) -> a -> b
$ (Ptr FontExtents -> IO FontExtents) -> IO FontExtents
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr FontExtents -> IO FontExtents) -> IO FontExtents)
-> (Ptr FontExtents -> IO FontExtents) -> IO FontExtents
forall a b. (a -> b) -> a -> b
$ \ret :: Ptr FontExtents
ret -> do
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO Bool) -> IO Bool)
-> (Ptr Font' -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' -> Ptr Font' -> Ptr FontExtents -> IO Bool
hb_font_get_v_extents Ptr Font'
font' Ptr FontExtents
ret
Ptr FontExtents -> IO FontExtents
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
data FontOptions = FontOptions {
FontOptions -> Maybe (Word, Word)
optionPPEm :: Maybe (Word, Word),
FontOptions -> Maybe Float
optionPtEm :: Maybe Float,
FontOptions -> Maybe (Int, Int)
optionScale :: Maybe (Int, Int),
FontOptions -> Maybe Face
optionFace :: Maybe Face,
FontOptions -> Maybe Font
optionParent :: Maybe Font,
FontOptions -> Maybe Float
optionSynthSlant :: Maybe Float,
FontOptions -> [Variation]
optionVariations :: [Variation],
FontOptions -> [Float]
optionVarCoordsDesign :: [Float],
FontOptions -> [Int]
optionVarCoordsNormalized :: [Int],
FontOptions -> Maybe Word
optionVarNamedInstance :: Maybe Word
} deriving (Int -> FontOptions -> ShowS
[FontOptions] -> ShowS
FontOptions -> String
(Int -> FontOptions -> ShowS)
-> (FontOptions -> String)
-> ([FontOptions] -> ShowS)
-> Show FontOptions
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
Eq FontOptions =>
(FontOptions -> FontOptions -> Ordering)
-> (FontOptions -> FontOptions -> Bool)
-> (FontOptions -> FontOptions -> Bool)
-> (FontOptions -> FontOptions -> Bool)
-> (FontOptions -> FontOptions -> Bool)
-> (FontOptions -> FontOptions -> FontOptions)
-> (FontOptions -> FontOptions -> FontOptions)
-> Ord 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
$cp1Ord :: Eq FontOptions
Ord, FontOptions -> FontOptions -> Bool
(FontOptions -> FontOptions -> Bool)
-> (FontOptions -> FontOptions -> Bool) -> Eq FontOptions
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)
defaultFontOptions :: FontOptions
defaultFontOptions = FontOptions :: Maybe (Word, Word)
-> Maybe Float
-> Maybe (Int, Int)
-> Maybe Face
-> Maybe Font
-> Maybe Float
-> [Variation]
-> [Float]
-> [Int]
-> Maybe Word
-> FontOptions
FontOptions {
optionPPEm :: Maybe (Word, Word)
optionPPEm = Maybe (Word, Word)
forall a. Maybe a
Nothing, optionPtEm :: Maybe Float
optionPtEm = Maybe Float
forall a. Maybe a
Nothing, optionScale :: Maybe (Int, Int)
optionScale = Maybe (Int, Int)
forall a. Maybe a
Nothing,
optionFace :: Maybe Face
optionFace = Maybe Face
forall a. Maybe a
Nothing, optionParent :: Maybe Font
optionParent = Maybe Font
forall a. Maybe a
Nothing, optionSynthSlant :: Maybe Float
optionSynthSlant = Maybe Float
forall a. Maybe a
Nothing,
optionVariations :: [Variation]
optionVariations = [], optionVarCoordsDesign :: [Float]
optionVarCoordsDesign = [], optionVarCoordsNormalized :: [Int]
optionVarCoordsNormalized = [],
optionVarNamedInstance :: Maybe Word
optionVarNamedInstance = Maybe Word
forall a. Maybe a
Nothing
}
_setFontOptions :: Ptr Font' -> FontOptions -> IO ()
_setFontOptions font :: Ptr Font'
font opts :: FontOptions
opts = do
case FontOptions -> Maybe (Word, Word)
optionPPEm FontOptions
opts of
Just (x :: Word
x, y :: Word
y) -> Ptr Font' -> Word -> Word -> IO ()
hb_font_set_ppem Ptr Font'
font Word
x Word
y
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case FontOptions -> Maybe Float
optionPtEm FontOptions
opts of
Just ptem :: Float
ptem -> Ptr Font' -> Float -> IO ()
hb_font_set_ptem Ptr Font'
font Float
ptem
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case FontOptions -> Maybe (Int, Int)
optionScale FontOptions
opts of
Just (x :: Int
x, y :: Int
y) -> Ptr Font' -> Int -> Int -> IO ()
hb_font_set_scale Ptr Font'
font Int
x Int
y
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case FontOptions -> Maybe Face
optionFace FontOptions
opts of
Just face :: Face
face -> Face -> (Ptr Face' -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
face ((Ptr Face' -> IO ()) -> IO ()) -> (Ptr Face' -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Ptr Face' -> IO ()
hb_font_set_face Ptr Font'
font
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case FontOptions -> Maybe Font
optionParent FontOptions
opts of
Just parent :: Font
parent -> Font -> (Ptr Font' -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
parent ((Ptr Font' -> IO ()) -> IO ()) -> (Ptr Font' -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Font' -> Ptr Font' -> IO ()
hb_font_set_parent Ptr Font'
font
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case FontOptions -> Maybe Float
optionSynthSlant FontOptions
opts of
Just slant :: Float
slant -> Ptr Font' -> Float -> IO ()
hb_font_set_synthetic_slant Ptr Font'
font Float
slant
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Variation] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Variation] -> Bool) -> [Variation] -> Bool
forall a b. (a -> b) -> a -> b
$ FontOptions -> [Variation]
optionVariations FontOptions
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Variation] -> (Int -> Ptr Variation -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (FontOptions -> [Variation]
optionVariations FontOptions
opts) ((Int -> Ptr Variation -> IO ()) -> IO ())
-> (Int -> Ptr Variation -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \len :: Int
len vars :: Ptr Variation
vars ->
Ptr Font' -> Ptr Variation -> Word -> IO ()
hb_font_set_variations Ptr Font'
font Ptr Variation
vars (Word -> IO ()) -> Word -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a. Enum a => Int -> a
toEnum Int
len
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Float] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Float] -> Bool) -> [Float] -> Bool
forall a b. (a -> b) -> a -> b
$ FontOptions -> [Float]
optionVarCoordsDesign FontOptions
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Float] -> (Int -> Ptr Float -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (FontOptions -> [Float]
optionVarCoordsDesign FontOptions
opts) ((Int -> Ptr Float -> IO ()) -> IO ())
-> (Int -> Ptr Float -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \len :: Int
len coords :: Ptr Float
coords ->
Ptr Font' -> Ptr Float -> Word -> IO ()
hb_font_set_var_coords_design Ptr Font'
font Ptr Float
coords (Word -> IO ()) -> Word -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a. Enum a => Int -> a
toEnum Int
len
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Int] -> Bool) -> [Int] -> Bool
forall a b. (a -> b) -> a -> b
$ FontOptions -> [Int]
optionVarCoordsNormalized FontOptions
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[Int] -> (Int -> Ptr Int -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (FontOptions -> [Int]
optionVarCoordsNormalized FontOptions
opts) ((Int -> Ptr Int -> IO ()) -> IO ())
-> (Int -> Ptr Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \len :: Int
len coords :: Ptr Int
coords ->
Ptr Font' -> Ptr Int -> Word -> IO ()
hb_font_set_var_coords_normalized Ptr Font'
font Ptr Int
coords (Word -> IO ()) -> Word -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a. Enum a => Int -> a
toEnum Int
len
case FontOptions -> Maybe Word
optionVarNamedInstance FontOptions
opts of
Just inst :: Word
inst -> Ptr Font' -> Word -> IO ()
hb_font_set_var_named_instance Ptr Font'
font Word
inst
Nothing -> () -> IO ()
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 ()
createFontWithOptions :: FontOptions -> Face -> Font
createFontWithOptions :: FontOptions -> Face -> Font
createFontWithOptions opts :: FontOptions
opts fce :: Face
fce = IO Font -> Font
forall a. IO a -> a
unsafePerformIO (IO Font -> Font) -> IO Font -> Font
forall a b. (a -> b) -> a -> b
$ do
Ptr Font'
font <- IO (Ptr Font') -> IO (Ptr Font')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Font') -> IO (Ptr Font'))
-> IO (Ptr Font') -> IO (Ptr Font')
forall a b. (a -> b) -> a -> b
$ Face -> (Ptr Face' -> IO (Ptr Font')) -> IO (Ptr Font')
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
fce ((Ptr Face' -> IO (Ptr Font')) -> IO (Ptr Font'))
-> (Ptr Face' -> IO (Ptr Font')) -> IO (Ptr Font')
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
FinalizerPtr Font' -> Ptr Font' -> IO Font
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Font'
hb_font_destroy Ptr Font'
font
ftCreateFontWithOptions :: FontOptions -> FT_Face -> Font
ftCreateFontWithOptions :: FontOptions -> FT_Face -> Font
ftCreateFontWithOptions opts :: FontOptions
opts fce :: FT_Face
fce = IO Font -> Font
forall a. IO a -> a
unsafePerformIO (IO Font -> Font) -> IO Font -> Font
forall a b. (a -> b) -> a -> b
$ do
Ptr Font'
font <- IO (Ptr Font') -> IO (Ptr Font')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Font') -> IO (Ptr Font'))
-> IO (Ptr Font') -> IO (Ptr Font')
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
FinalizerPtr Font' -> Ptr Font' -> IO Font
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Font'
hb_font_destroy Ptr Font'
font
createSubFontWithOptions :: FontOptions -> Font -> Font
createSubFontWithOptions :: FontOptions -> Font -> Font
createSubFontWithOptions opts :: FontOptions
opts font :: Font
font = IO Font -> Font
forall a. IO a -> a
unsafePerformIO (IO Font -> Font) -> IO Font -> Font
forall a b. (a -> b) -> a -> b
$ do
Ptr Font'
font <- IO (Ptr Font') -> IO (Ptr Font')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Font') -> IO (Ptr Font'))
-> IO (Ptr Font') -> IO (Ptr Font')
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO (Ptr Font')) -> IO (Ptr Font')
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO (Ptr Font')) -> IO (Ptr Font'))
-> (Ptr Font' -> IO (Ptr Font')) -> IO (Ptr 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
FinalizerPtr Font' -> Ptr Font' -> IO Font
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Font'
hb_font_destroy Ptr Font'
font
type Blob = ForeignPtr Blob'
data Blob'
type Blob_ = Ptr Blob'
bs2blob :: ByteString -> IO Blob
bs2blob :: ByteString -> IO Blob
bs2blob (BS bytes :: ForeignPtr Word8
bytes len :: Int
len) = do
Ptr Blob'
blob <- IO (Ptr Blob') -> IO (Ptr Blob')
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr Blob') -> IO (Ptr Blob'))
-> IO (Ptr Blob') -> IO (Ptr Blob')
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO (Ptr Blob')) -> IO (Ptr Blob')
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
bytes ((Ptr Word8 -> IO (Ptr Blob')) -> IO (Ptr Blob'))
-> (Ptr Word8 -> IO (Ptr Blob')) -> IO (Ptr Blob')
forall a b. (a -> b) -> a -> b
$ \bytes' :: Ptr Word8
bytes' ->
Ptr Word8
-> Int
-> Int
-> Ptr ()
-> FunPtr (Ptr () -> IO ())
-> IO (Ptr Blob')
hb_blob_create Ptr Word8
bytes' Int
len Int
hb_MEMORY_MODE_DUPLICATE Ptr ()
forall a. Ptr a
nullPtr FunPtr (Ptr () -> IO ())
forall a. FunPtr a
nullFunPtr
FinalizerPtr Blob' -> Ptr Blob' -> IO Blob
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Blob'
hb_blob_destroy Ptr Blob'
blob
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 = 0
foreign import ccall "&hb_blob_destroy" hb_blob_destroy :: FunPtr (Blob_ -> IO ())
blob2bs :: Blob_ -> ByteString
blob2bs :: Ptr Blob' -> ByteString
blob2bs blob :: Ptr Blob'
blob = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Ptr Word -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word -> IO ByteString) -> IO ByteString)
-> (Ptr Word -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \length' :: Ptr Word
length' -> do
Ptr CChar
dat <- Ptr Blob' -> Ptr Word -> IO (Ptr CChar)
hb_blob_get_data Ptr Blob'
blob Ptr Word
length'
Word
length <- Ptr Word -> IO Word
forall a. Storable a => Ptr a -> IO a
peek Ptr Word
length'
ByteString
ret <- CStringLen -> IO ByteString
packCStringLen (Ptr CChar
dat, Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
length)
Ptr Blob' -> IO ()
hb_blob_destroy' Ptr Blob'
blob
ByteString -> IO ByteString
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 ()
faceFunc :: (Face_ -> a) -> (Face -> a)
faceFunc :: (Ptr Face' -> a) -> Face -> a
faceFunc cb :: Ptr Face' -> a
cb fce :: Face
fce = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Face -> (Ptr Face' -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
fce ((Ptr Face' -> IO a) -> IO a) -> (Ptr Face' -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (Ptr Face' -> a) -> Ptr Face' -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Face' -> a
cb
fontFunc :: (Font_ -> a) -> (Font -> a)
fontFunc :: (Ptr Font' -> a) -> Font -> a
fontFunc cb :: Ptr Font' -> a
cb fnt :: Font
fnt = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Font -> (Ptr Font' -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
fnt ((Ptr Font' -> IO a) -> IO a) -> (Ptr Font' -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (Ptr Font' -> a) -> Ptr Font' -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font' -> a
cb
faceCollectFunc :: (Face_ -> Set_ -> IO ()) -> (Face -> [Word32])
faceCollectFunc :: (Ptr Face' -> Set_ -> IO ()) -> Face -> [Word32]
faceCollectFunc cb :: Ptr Face' -> Set_ -> IO ()
cb fce :: Face
fce = IO [Word32] -> [Word32]
forall a. IO a -> a
unsafePerformIO (IO [Word32] -> [Word32]) -> IO [Word32] -> [Word32]
forall a b. (a -> b) -> a -> b
$ Face -> (Ptr Face' -> IO [Word32]) -> IO [Word32]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Face
fce ((Ptr Face' -> IO [Word32]) -> IO [Word32])
-> (Ptr Face' -> IO [Word32]) -> IO [Word32]
forall a b. (a -> b) -> a -> b
$ \fce' :: Ptr Face'
fce' -> do
Set
set <- IO Set
createSet
Set -> (Set_ -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Set
set ((Set_ -> IO ()) -> IO ()) -> (Set_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Face' -> Set_ -> IO ()
cb Ptr Face'
fce'
Set -> IO [Word32]
set2list Set
set
data Set'
type Set = ForeignPtr Set'
type Set_ = Ptr Set'
createSet :: IO Set
createSet :: IO Set
createSet = do
Set_
ret <- IO Set_ -> IO Set_
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull IO Set_
hb_set_create
FinalizerPtr Set' -> Set_ -> IO Set
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Set'
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 ())
setNext :: Set -> Word32 -> Maybe Word32
setNext :: Set -> Word32 -> Maybe Word32
setNext set :: Set
set iter :: Word32
iter = IO (Maybe Word32) -> Maybe Word32
forall a. IO a -> a
unsafePerformIO (IO (Maybe Word32) -> Maybe Word32)
-> IO (Maybe Word32) -> Maybe Word32
forall a b. (a -> b) -> a -> b
$ Set -> (Set_ -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Set
set ((Set_ -> IO (Maybe Word32)) -> IO (Maybe Word32))
-> (Set_ -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ \set' :: Set_
set' -> (Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32))
-> (Ptr Word32 -> IO (Maybe Word32)) -> IO (Maybe Word32)
forall a b. (a -> b) -> a -> b
$ \iter' :: Ptr Word32
iter' -> do
Ptr Word32 -> Word32 -> IO ()
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 Maybe Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Word32 -> IO (Maybe Word32))
-> (Word32 -> Maybe Word32) -> Word32 -> IO (Maybe Word32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> IO (Maybe Word32)) -> IO Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
iter'
else Maybe Word32 -> IO (Maybe Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word32
forall a. Maybe a
Nothing
foreign import ccall "hb_set_next" hb_set_next :: Set_ -> Ptr Word32 -> IO Bool
set2list :: Set -> IO [Word32]
set2list :: Set -> IO [Word32]
set2list set :: Set
set = [Word32] -> IO [Word32]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Word32] -> IO [Word32]) -> [Word32] -> IO [Word32]
forall a b. (a -> b) -> a -> b
$ Word32 -> [Word32]
inner Word32
forall a. Bounded a => a
maxBound
where
inner :: Word32 -> [Word32]
inner iter :: Word32
iter | Just x :: Word32
x <- Set -> Word32 -> Maybe Word32
setNext Set
set Word32
iter = Word32
x Word32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
: Word32 -> [Word32]
inner Word32
x
| Bool
otherwise = []