{-# LANGUAGE OverloadedStrings #-}
module Data.Text.Glyphize (shape, version, versionAtLeast, versionString, HarfbuzzError(..),
Buffer(..), ContentType(..), ClusterLevel(..), Direction(..), defaultBuffer,
dirFromStr, dirToStr, dirReverse, dirBackward, dirForward, dirHorizontal, dirVertical,
scriptHorizontalDir, languageDefault, tag_from_string, tag_to_string, guessSegmentProperties,
GlyphInfo(..), GlyphPos(..), Feature(..), featTag, Variation(..), varTag,
parseFeature, unparseFeature, parseVariation, unparseVariation, globalStart, globalEnd,
countFace, Face, createFace, ftCreateFace, emptyFace, faceTableTags, faceGlyphCount,
faceCollectUnicodes, faceCollectVarSels, faceCollectVarUnicodes, faceIndex, faceUpem,
faceBlob, faceTable,
Font, createFont, ftCreateFont, emptyFont, fontFace, fontGlyph, fontGlyphAdvance,
fontGlyphContourPoint, fontGlyphContourPointForOrigin, fontGlyphFromName,
fontGlyphHAdvance, fontGlyphVAdvance, fontGlyphHKerning, fontGlyphHOrigin, fontGlyphVOrigin,
fontGlyphKerningForDir, fontGlyphName, fontGlyphName_, fontGlyphOriginForDir,
fontNominalGlyph, fontPPEm, fontPtEm, fontScale, fontVarGlyph, fontSyntheticSlant,
fontVarCoordsNormalized, fontTxt2Glyph, fontGlyph2Str, fontVarCoordsDesign,
GlyphExtents(..), fontGlyphExtents, fontGlyphExtentsForOrigin,
FontExtents(..), fontExtentsForDir, fontHExtents, fontVExtents,
FontOptions(..), defaultFontOptions, createFontWithOptions, ftCreateFontWithOptions,
) where
import Data.Text.Glyphize.Font
import Data.Text.Glyphize.Buffer
import Data.Text.Glyphize.Oom
import Data.Text.Glyphize.Array (noCache)
import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO)
import Foreign.Ptr (Ptr(..))
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Storable (peek)
import Foreign.C.String (CString(..), peekCString)
import Foreign.Marshal.Array (withArrayLen)
shape :: Font -> Buffer -> [Feature] -> [(GlyphInfo, GlyphPos)]
shape :: Font -> Buffer -> [Feature] -> [(GlyphInfo, GlyphPos)]
shape Font
_ Buffer {text :: Buffer -> Text
text = Text
""} [Feature]
_ = []
shape Font
font Buffer
buffer [Feature]
features = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Buffer -> (Buffer' -> IO a) -> IO a
withBuffer Buffer
buffer forall a b. (a -> b) -> a -> b
$ \Buffer'
buffer' -> do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font forall a b. (a -> b) -> a -> b
$ \Ptr Font'
font' -> forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Feature]
features forall a b. (a -> b) -> a -> b
$ \Int
len Ptr Feature
features' ->
Ptr Font' -> Buffer' -> Ptr Feature -> Word -> IO ()
hb_shape Ptr Font'
font' Buffer'
buffer' Ptr Feature
features' forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
len
[GlyphInfo]
infos <- Buffer' -> IO [GlyphInfo]
glyphInfos Buffer'
buffer'
[GlyphPos]
pos <- Buffer' -> IO [GlyphPos]
glyphsPos Buffer'
buffer'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> a -> b
noCache forall a b. [a] -> [b] -> [(a, b)]
zip [GlyphInfo]
infos [GlyphPos]
pos
foreign import ccall "hb_shape" hb_shape :: Font_ -> Buffer' -> Ptr Feature -> Word -> IO ()
guessSegmentProperties :: Buffer -> Buffer
guessSegmentProperties :: Buffer -> Buffer
guessSegmentProperties = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Buffer -> (Buffer' -> IO a) -> IO a
withBuffer Buffer' -> IO Buffer
thawBuffer
foreign import ccall "hb_version" hb_version :: Ptr Int -> Ptr Int -> Ptr Int -> IO ()
version :: (Int, Int, Int)
version :: (Int, Int, Int)
version = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int
a' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int
b' -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Int
c' -> do
Ptr Int -> Ptr Int -> Ptr Int -> IO ()
hb_version Ptr Int
a' Ptr Int
b' Ptr Int
c'
Int
a <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int
a'
Int
b <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int
b'
Int
c <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int
c'
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
a, Int
b, Int
c)
foreign import ccall "hb_version_atleast" versionAtLeast :: Int -> Int -> Int -> Bool
foreign import ccall "hb_version_string" hb_version_string :: CString
versionString :: String
versionString :: String
versionString = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ CString -> IO String
peekCString CString
hb_version_string