{-# LANGUAGE OverloadedStrings #-}
-- | HarfBuzz is a text shaping library.
-- Using the HarfBuzz library allows programs to convert a sequence of
-- Unicode input into properly formatted and positioned glyph output
-- for practically any writing system and language.
-- See `shape` for the central function all other datatypes serves to support.
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 System.IO.Unsafe (unsafePerformIO)
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)

-- | Shapes the text in the given `Buffer` according to the given `Font`
-- yielding glyphs and their positions.
-- If any `Feature`s are given they will be applied during shaping.
-- If two `Feature`s have the same tag but overlapping ranges
-- the value of the `Feature` with the higher index takes precedance.
shape :: Font -> Buffer -> [Feature] -> [(GlyphInfo, GlyphPos)]
shape :: Font -> Buffer -> [Feature] -> [(GlyphInfo, GlyphPos)]
shape _ Buffer {text :: Buffer -> Text
text = Text
""} _ = []
shape font :: Font
font buffer :: Buffer
buffer features :: [Feature]
features = IO [(GlyphInfo, GlyphPos)] -> [(GlyphInfo, GlyphPos)]
forall a. IO a -> a
unsafePerformIO (IO [(GlyphInfo, GlyphPos)] -> [(GlyphInfo, GlyphPos)])
-> IO [(GlyphInfo, GlyphPos)] -> [(GlyphInfo, GlyphPos)]
forall a b. (a -> b) -> a -> b
$ Font
-> (Ptr Font' -> IO [(GlyphInfo, GlyphPos)])
-> IO [(GlyphInfo, GlyphPos)]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr Font' -> IO [(GlyphInfo, GlyphPos)])
 -> IO [(GlyphInfo, GlyphPos)])
-> (Ptr Font' -> IO [(GlyphInfo, GlyphPos)])
-> IO [(GlyphInfo, GlyphPos)]
forall a b. (a -> b) -> a -> b
$ \font' :: Ptr Font'
font' ->
    Buffer
-> (Buffer' -> IO [(GlyphInfo, GlyphPos)])
-> IO [(GlyphInfo, GlyphPos)]
forall a. Buffer -> (Buffer' -> IO a) -> IO a
withBuffer Buffer
buffer ((Buffer' -> IO [(GlyphInfo, GlyphPos)])
 -> IO [(GlyphInfo, GlyphPos)])
-> (Buffer' -> IO [(GlyphInfo, GlyphPos)])
-> IO [(GlyphInfo, GlyphPos)]
forall a b. (a -> b) -> a -> b
$ \buffer' :: Buffer'
buffer' -> [Feature]
-> (Int -> Ptr Feature -> IO [(GlyphInfo, GlyphPos)])
-> IO [(GlyphInfo, GlyphPos)]
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Feature]
features ((Int -> Ptr Feature -> IO [(GlyphInfo, GlyphPos)])
 -> IO [(GlyphInfo, GlyphPos)])
-> (Int -> Ptr Feature -> IO [(GlyphInfo, GlyphPos)])
-> IO [(GlyphInfo, GlyphPos)]
forall a b. (a -> b) -> a -> b
$ \len :: Int
len features' :: Ptr Feature
features' -> do
        Ptr Font' -> Buffer' -> Ptr Feature -> Word -> IO ()
hb_shape Ptr Font'
font' Buffer'
buffer' Ptr Feature
features' (Word -> IO ()) -> Word -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Word
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'
        [(GlyphInfo, GlyphPos)] -> IO [(GlyphInfo, GlyphPos)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(GlyphInfo, GlyphPos)] -> IO [(GlyphInfo, GlyphPos)])
-> [(GlyphInfo, GlyphPos)] -> IO [(GlyphInfo, GlyphPos)]
forall a b. (a -> b) -> a -> b
$ [GlyphInfo] -> [GlyphPos] -> [(GlyphInfo, GlyphPos)]
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 ()

-- | Fills in unset segment properties based on buffer unicode contents.
-- If buffer is not empty it must have `ContentType` `ContentTypeUnicode`.
-- If buffer script is not set it will be set to the Unicode script of the first
-- character in the buffer that has a script other than "common", "inherited",
-- or "unknown".
-- Next if the buffer direction is not set it will be set to the natural
-- horizontal direction of the buffer script as returned by `scriptHorizontalDir`.
-- If `scriptHorizontalDir` returns `Nothing`, then `DirLTR` is used.
-- Finally if buffer language is not set, it will be set to the process's default
-- language as returned by `languageDefault`. This may change in the future by
-- taking buffer script into consideration when choosting a language.
-- Note that `languageDefault` is not thread-safe the first time it is called.
-- See documentation for that function for details.
guessSegmentProperties :: Buffer -> Buffer
guessSegmentProperties :: Buffer -> Buffer
guessSegmentProperties = IO Buffer -> Buffer
forall a. IO a -> a
unsafePerformIO (IO Buffer -> Buffer) -> (Buffer -> IO Buffer) -> Buffer -> Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> (Buffer' -> IO Buffer) -> IO Buffer)
-> (Buffer' -> IO Buffer) -> Buffer -> IO Buffer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Buffer -> (Buffer' -> IO Buffer) -> IO Buffer
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 ()
-- | Returns the library version as 3 integer components.
version :: (Int, Int, Int)
version :: (Int, Int, Int)
version = IO (Int, Int, Int) -> (Int, Int, Int)
forall a. IO a -> a
unsafePerformIO (IO (Int, Int, Int) -> (Int, Int, Int))
-> IO (Int, Int, Int) -> (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$
    (Ptr Int -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr Int -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \a' :: Ptr Int
a' -> (Ptr Int -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr Int -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \b' :: Ptr Int
b' -> (Ptr Int -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr Int -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \c' :: Ptr Int
c' -> do
        Ptr Int -> Ptr Int -> Ptr Int -> IO ()
hb_version Ptr Int
a' Ptr Int
b' Ptr Int
c'
        Int
a <- Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peek Ptr Int
a'
        Int
b <- Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peek Ptr Int
b'
        Int
c <- Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peek Ptr Int
c'
        (Int, Int, Int) -> IO (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
a, Int
b, Int
c)
-- | Tests the library version against a minimum value, as 3 integer components.
foreign import ccall "hb_version_atleast" versionAtLeast :: Int -> Int -> Int -> Bool
foreign import ccall "hb_version_string" hb_version_string :: CString
-- | Returns library version as a string with 3 integer components.
versionString :: String
versionString :: String
versionString = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ CString -> IO String
peekCString CString
hb_version_string