{-# LANGUAGE MagicHash, UnliftedFFITypes, DeriveGeneric #-}
module Data.Text.Glyphize.Buffer where
import qualified Data.Text.Internal.Lazy as Lazy
import qualified Data.Text.Lazy as Lazy (Text, pack)
import qualified Data.Text.Internal as Txt
import Data.Char (toUpper, toLower)
import Control.Monad (forM)
import Control.Exception (bracket)
import Data.Text.Glyphize.Oom (throwFalse, throwNull)
import qualified Data.Text.Array as A
import GHC.Exts (ByteArray#, sizeofByteArray#, Int#)
import Data.Word (Word32)
import Data.Int (Int32)
import Data.Bits ((.|.), (.&.), shiftR, shiftL, testBit)
import System.IO.Unsafe (unsafePerformIO)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Ptr
import Foreign.C.String (CString, withCString, peekCString)
import Foreign.Storable (Storable(..))
import GHC.Generics (Generic(..))
import Foreign.Storable.Generic (GStorable(..))
data Buffer = Buffer {
Buffer -> Text
text :: Lazy.Text,
Buffer -> Maybe ContentType
contentType :: Maybe ContentType,
Buffer -> Maybe Direction
direction :: Maybe Direction,
Buffer -> Maybe String
script :: Maybe String,
Buffer -> Maybe String
language :: Maybe String,
Buffer -> Bool
beginsText :: Bool,
Buffer -> Bool
endsText :: Bool,
Buffer -> Bool
preserveDefaultIgnorables :: Bool,
Buffer -> Bool
removeDefaultIgnorables :: Bool,
Buffer -> Bool
don'tInsertDottedCircle :: Bool,
Buffer -> ClusterLevel
clusterLevel :: ClusterLevel,
Buffer -> Char
invisibleGlyph :: Char,
Buffer -> Char
replacementCodepoint :: Char,
Buffer -> Char
notFoundGlyph :: Char
} deriving (Buffer -> Buffer -> Bool
(Buffer -> Buffer -> Bool)
-> (Buffer -> Buffer -> Bool) -> Eq Buffer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Buffer -> Buffer -> Bool
$c/= :: Buffer -> Buffer -> Bool
== :: Buffer -> Buffer -> Bool
$c== :: Buffer -> Buffer -> Bool
Eq, Int -> Buffer -> ShowS
[Buffer] -> ShowS
Buffer -> String
(Int -> Buffer -> ShowS)
-> (Buffer -> String) -> ([Buffer] -> ShowS) -> Show Buffer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Buffer] -> ShowS
$cshowList :: [Buffer] -> ShowS
show :: Buffer -> String
$cshow :: Buffer -> String
showsPrec :: Int -> Buffer -> ShowS
$cshowsPrec :: Int -> Buffer -> ShowS
Show, ReadPrec [Buffer]
ReadPrec Buffer
Int -> ReadS Buffer
ReadS [Buffer]
(Int -> ReadS Buffer)
-> ReadS [Buffer]
-> ReadPrec Buffer
-> ReadPrec [Buffer]
-> Read Buffer
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Buffer]
$creadListPrec :: ReadPrec [Buffer]
readPrec :: ReadPrec Buffer
$creadPrec :: ReadPrec Buffer
readList :: ReadS [Buffer]
$creadList :: ReadS [Buffer]
readsPrec :: Int -> ReadS Buffer
$creadsPrec :: Int -> ReadS Buffer
Read, Eq Buffer
Eq Buffer =>
(Buffer -> Buffer -> Ordering)
-> (Buffer -> Buffer -> Bool)
-> (Buffer -> Buffer -> Bool)
-> (Buffer -> Buffer -> Bool)
-> (Buffer -> Buffer -> Bool)
-> (Buffer -> Buffer -> Buffer)
-> (Buffer -> Buffer -> Buffer)
-> Ord Buffer
Buffer -> Buffer -> Bool
Buffer -> Buffer -> Ordering
Buffer -> Buffer -> Buffer
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 :: Buffer -> Buffer -> Buffer
$cmin :: Buffer -> Buffer -> Buffer
max :: Buffer -> Buffer -> Buffer
$cmax :: Buffer -> Buffer -> Buffer
>= :: Buffer -> Buffer -> Bool
$c>= :: Buffer -> Buffer -> Bool
> :: Buffer -> Buffer -> Bool
$c> :: Buffer -> Buffer -> Bool
<= :: Buffer -> Buffer -> Bool
$c<= :: Buffer -> Buffer -> Bool
< :: Buffer -> Buffer -> Bool
$c< :: Buffer -> Buffer -> Bool
compare :: Buffer -> Buffer -> Ordering
$ccompare :: Buffer -> Buffer -> Ordering
$cp1Ord :: Eq Buffer
Ord)
data ContentType = ContentTypeUnicode | ContentTypeGlyphs deriving (ContentType -> ContentType -> Bool
(ContentType -> ContentType -> Bool)
-> (ContentType -> ContentType -> Bool) -> Eq ContentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentType -> ContentType -> Bool
$c/= :: ContentType -> ContentType -> Bool
== :: ContentType -> ContentType -> Bool
$c== :: ContentType -> ContentType -> Bool
Eq, Int -> ContentType -> ShowS
[ContentType] -> ShowS
ContentType -> String
(Int -> ContentType -> ShowS)
-> (ContentType -> String)
-> ([ContentType] -> ShowS)
-> Show ContentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentType] -> ShowS
$cshowList :: [ContentType] -> ShowS
show :: ContentType -> String
$cshow :: ContentType -> String
showsPrec :: Int -> ContentType -> ShowS
$cshowsPrec :: Int -> ContentType -> ShowS
Show, ReadPrec [ContentType]
ReadPrec ContentType
Int -> ReadS ContentType
ReadS [ContentType]
(Int -> ReadS ContentType)
-> ReadS [ContentType]
-> ReadPrec ContentType
-> ReadPrec [ContentType]
-> Read ContentType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContentType]
$creadListPrec :: ReadPrec [ContentType]
readPrec :: ReadPrec ContentType
$creadPrec :: ReadPrec ContentType
readList :: ReadS [ContentType]
$creadList :: ReadS [ContentType]
readsPrec :: Int -> ReadS ContentType
$creadsPrec :: Int -> ReadS ContentType
Read, Eq ContentType
Eq ContentType =>
(ContentType -> ContentType -> Ordering)
-> (ContentType -> ContentType -> Bool)
-> (ContentType -> ContentType -> Bool)
-> (ContentType -> ContentType -> Bool)
-> (ContentType -> ContentType -> Bool)
-> (ContentType -> ContentType -> ContentType)
-> (ContentType -> ContentType -> ContentType)
-> Ord ContentType
ContentType -> ContentType -> Bool
ContentType -> ContentType -> Ordering
ContentType -> ContentType -> ContentType
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 :: ContentType -> ContentType -> ContentType
$cmin :: ContentType -> ContentType -> ContentType
max :: ContentType -> ContentType -> ContentType
$cmax :: ContentType -> ContentType -> ContentType
>= :: ContentType -> ContentType -> Bool
$c>= :: ContentType -> ContentType -> Bool
> :: ContentType -> ContentType -> Bool
$c> :: ContentType -> ContentType -> Bool
<= :: ContentType -> ContentType -> Bool
$c<= :: ContentType -> ContentType -> Bool
< :: ContentType -> ContentType -> Bool
$c< :: ContentType -> ContentType -> Bool
compare :: ContentType -> ContentType -> Ordering
$ccompare :: ContentType -> ContentType -> Ordering
$cp1Ord :: Eq ContentType
Ord)
data ClusterLevel = ClusterMonotoneGraphemes | ClusterMonotoneChars | ClusterChars
deriving (ClusterLevel -> ClusterLevel -> Bool
(ClusterLevel -> ClusterLevel -> Bool)
-> (ClusterLevel -> ClusterLevel -> Bool) -> Eq ClusterLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClusterLevel -> ClusterLevel -> Bool
$c/= :: ClusterLevel -> ClusterLevel -> Bool
== :: ClusterLevel -> ClusterLevel -> Bool
$c== :: ClusterLevel -> ClusterLevel -> Bool
Eq, Int -> ClusterLevel -> ShowS
[ClusterLevel] -> ShowS
ClusterLevel -> String
(Int -> ClusterLevel -> ShowS)
-> (ClusterLevel -> String)
-> ([ClusterLevel] -> ShowS)
-> Show ClusterLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterLevel] -> ShowS
$cshowList :: [ClusterLevel] -> ShowS
show :: ClusterLevel -> String
$cshow :: ClusterLevel -> String
showsPrec :: Int -> ClusterLevel -> ShowS
$cshowsPrec :: Int -> ClusterLevel -> ShowS
Show, ReadPrec [ClusterLevel]
ReadPrec ClusterLevel
Int -> ReadS ClusterLevel
ReadS [ClusterLevel]
(Int -> ReadS ClusterLevel)
-> ReadS [ClusterLevel]
-> ReadPrec ClusterLevel
-> ReadPrec [ClusterLevel]
-> Read ClusterLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClusterLevel]
$creadListPrec :: ReadPrec [ClusterLevel]
readPrec :: ReadPrec ClusterLevel
$creadPrec :: ReadPrec ClusterLevel
readList :: ReadS [ClusterLevel]
$creadList :: ReadS [ClusterLevel]
readsPrec :: Int -> ReadS ClusterLevel
$creadsPrec :: Int -> ReadS ClusterLevel
Read, Eq ClusterLevel
Eq ClusterLevel =>
(ClusterLevel -> ClusterLevel -> Ordering)
-> (ClusterLevel -> ClusterLevel -> Bool)
-> (ClusterLevel -> ClusterLevel -> Bool)
-> (ClusterLevel -> ClusterLevel -> Bool)
-> (ClusterLevel -> ClusterLevel -> Bool)
-> (ClusterLevel -> ClusterLevel -> ClusterLevel)
-> (ClusterLevel -> ClusterLevel -> ClusterLevel)
-> Ord ClusterLevel
ClusterLevel -> ClusterLevel -> Bool
ClusterLevel -> ClusterLevel -> Ordering
ClusterLevel -> ClusterLevel -> ClusterLevel
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 :: ClusterLevel -> ClusterLevel -> ClusterLevel
$cmin :: ClusterLevel -> ClusterLevel -> ClusterLevel
max :: ClusterLevel -> ClusterLevel -> ClusterLevel
$cmax :: ClusterLevel -> ClusterLevel -> ClusterLevel
>= :: ClusterLevel -> ClusterLevel -> Bool
$c>= :: ClusterLevel -> ClusterLevel -> Bool
> :: ClusterLevel -> ClusterLevel -> Bool
$c> :: ClusterLevel -> ClusterLevel -> Bool
<= :: ClusterLevel -> ClusterLevel -> Bool
$c<= :: ClusterLevel -> ClusterLevel -> Bool
< :: ClusterLevel -> ClusterLevel -> Bool
$c< :: ClusterLevel -> ClusterLevel -> Bool
compare :: ClusterLevel -> ClusterLevel -> Ordering
$ccompare :: ClusterLevel -> ClusterLevel -> Ordering
$cp1Ord :: Eq ClusterLevel
Ord)
defaultBuffer :: Buffer
defaultBuffer = Buffer :: Text
-> Maybe ContentType
-> Maybe Direction
-> Maybe String
-> Maybe String
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ClusterLevel
-> Char
-> Char
-> Char
-> Buffer
Buffer {
text :: Text
text = Text
Lazy.empty,
contentType :: Maybe ContentType
contentType = ContentType -> Maybe ContentType
forall a. a -> Maybe a
Just ContentType
ContentTypeUnicode,
direction :: Maybe Direction
direction = Maybe Direction
forall a. Maybe a
Nothing,
script :: Maybe String
script = Maybe String
forall a. Maybe a
Nothing,
language :: Maybe String
language = Maybe String
forall a. Maybe a
Nothing,
beginsText :: Bool
beginsText = Bool
True,
endsText :: Bool
endsText = Bool
True,
preserveDefaultIgnorables :: Bool
preserveDefaultIgnorables = Bool
False,
removeDefaultIgnorables :: Bool
removeDefaultIgnorables = Bool
False,
don'tInsertDottedCircle :: Bool
don'tInsertDottedCircle = Bool
False,
clusterLevel :: ClusterLevel
clusterLevel = ClusterLevel
ClusterMonotoneGraphemes,
invisibleGlyph :: Char
invisibleGlyph = ' ',
replacementCodepoint :: Char
replacementCodepoint = '\xFFFD',
notFoundGlyph :: Char
notFoundGlyph = '\0'
}
data Direction = DirLTR | DirRTL | DirTTB | DirBTT deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
(Int -> ReadS Direction)
-> ReadS [Direction]
-> ReadPrec Direction
-> ReadPrec [Direction]
-> Read Direction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Direction]
$creadListPrec :: ReadPrec [Direction]
readPrec :: ReadPrec Direction
$creadPrec :: ReadPrec Direction
readList :: ReadS [Direction]
$creadList :: ReadS [Direction]
readsPrec :: Int -> ReadS Direction
$creadsPrec :: Int -> ReadS Direction
Read, Eq Direction
Eq Direction =>
(Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
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 :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
$cp1Ord :: Eq Direction
Ord)
dirFromStr :: String -> Maybe Direction
dirFromStr ('L':_) = Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
DirLTR
dirFromStr ('l':_) = Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
DirLTR
dirFromStr ('R':_) = Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
DirRTL
dirFromStr ('r':_) = Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
DirRTL
dirFromStr ('T':_) = Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
DirTTB
dirFromStr ('t':_) = Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
DirTTB
dirFromStr ('B':_) = Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
DirBTT
dirFromStr ('b':_) = Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
DirBTT
dirFromStr _ = Maybe Direction
forall a. Maybe a
Nothing
dirToStr :: Direction -> String
dirToStr DirLTR = "ltr"
dirToStr DirRTL = "rtl"
dirToStr DirTTB = "ttb"
dirToStr DirBTT = "btt"
dirReverse :: Direction -> Direction
dirReverse DirLTR = Direction
DirRTL
dirReverse DirRTL = Direction
DirLTR
dirReverse DirTTB = Direction
DirBTT
dirReverse DirBTT = Direction
DirTTB
dirBackward :: Direction -> Bool
dirBackward dir :: Direction
dir = Direction
dir Direction -> [Direction] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Direction
DirRTL, Direction
DirBTT]
dirForward :: Direction -> Bool
dirForward dir :: Direction
dir = Direction
dir Direction -> [Direction] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Direction
DirLTR, Direction
DirTTB]
dirHorizontal :: Direction -> Bool
dirHorizontal dir :: Direction
dir = Direction
dir Direction -> [Direction] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Direction
DirLTR, Direction
DirRTL]
dirVertical :: Direction -> Bool
dirVertical dir :: Direction
dir = Direction
dir Direction -> [Direction] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Direction
DirTTB, Direction
DirBTT]
dir2int :: Maybe Direction -> p
dir2int Nothing = 0
dir2int (Just DirLTR) = 4
dir2int (Just DirRTL) = 5
dir2int (Just DirTTB) = 6
dir2int (Just DirBTT) = 7
foreign import ccall "hb_buffer_set_direction" hb_buffer_set_direction
:: Buffer' -> Int -> IO ()
int2dir :: a -> Maybe Direction
int2dir 4 = Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
DirLTR
int2dir 5 = Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
DirRTL
int2dir 6 = Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
DirTTB
int2dir 7 = Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
DirBTT
int2dir _ = Maybe Direction
forall a. Maybe a
Nothing
scriptHorizontalDir :: String -> Maybe Direction
scriptHorizontalDir :: String -> Maybe Direction
scriptHorizontalDir = Int -> Maybe Direction
forall a. (Eq a, Num a) => a -> Maybe Direction
int2dir (Int -> Maybe Direction)
-> (String -> Int) -> String -> Maybe Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
hb_script_get_horizontal_direction (Word32 -> Int) -> (String -> Word32) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Word32
script_from_string
foreign import ccall "hb_script_get_horizontal_direction" hb_script_get_horizontal_direction
:: Word32 -> Int
data Language'
type Language = Ptr Language'
languageDefault :: IO String
languageDefault :: IO String
languageDefault = IO Language
hb_language_get_default IO Language -> (Language -> IO CString) -> IO CString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Language -> IO CString
hb_language_to_string IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString
foreign import ccall "hb_language_to_string" hb_language_to_string :: Language -> IO CString
foreign import ccall "hb_language_get_default" hb_language_get_default :: IO Language
hb_language_from_string :: String -> IO Language
hb_language_from_string :: String -> IO Language
hb_language_from_string str :: String
str =
String -> (CString -> IO Language) -> IO Language
forall a. String -> (CString -> IO a) -> IO a
withCString String
str ((CString -> IO Language) -> IO Language)
-> (CString -> IO Language) -> IO Language
forall a b. (a -> b) -> a -> b
$ \str' :: CString
str' -> CString -> Int -> IO Language
hb_language_from_string' CString
str' (-1)
foreign import ccall "hb_language_from_string" hb_language_from_string'
:: CString -> Int -> IO Language
data Buffer''
type Buffer' = Ptr Buffer''
withNewBuffer :: (Buffer' -> IO a) -> IO a
withNewBuffer :: (Buffer' -> IO a) -> IO a
withNewBuffer cb :: Buffer' -> IO a
cb = IO Buffer' -> (Buffer' -> IO ()) -> (Buffer' -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Buffer'
hb_buffer_create Buffer' -> IO ()
hb_buffer_destroy Buffer' -> IO a
cb
foreign import ccall "hb_buffer_create" hb_buffer_create :: IO Buffer'
foreign import ccall "hb_buffer_destroy" hb_buffer_destroy :: Buffer' -> IO ()
bufferWithText :: Buffer' -> Text -> IO b -> IO b
bufferWithText _ Lazy.Empty cb :: IO b
cb = IO b
cb
bufferWithText buffer :: Buffer'
buffer txt :: Text
txt@(Lazy.Chunk (Txt.Text (A.ByteArray arr :: ByteArray#
arr) offset :: Int
offset length :: Int
length) txts :: Text
txts) cb :: IO b
cb = do
Buffer' -> ByteArray# -> Int# -> Word -> Int -> IO ()
hb_buffer_add_utf8 Buffer'
buffer ByteArray#
arr (ByteArray# -> Int#
sizeofByteArray# ByteArray#
arr) (Int -> Word
forall a. Enum a => Int -> a
toEnum Int
offset) Int
length
Buffer' -> Text -> IO b -> IO b
bufferWithText Buffer'
buffer Text
txts IO b
cb
foreign import ccall "hb_buffer_add_utf8" hb_buffer_add_utf8
:: Buffer' -> ByteArray# -> Int# -> Word -> Int -> IO ()
titlecase :: String -> String
titlecase :: ShowS
titlecase "" = ""
titlecase (c :: Char
c:cs :: String
cs) = Char -> Char
toUpper Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Char -> Char
toLower String
cs
script_from_string :: String -> Word32
script_from_string :: String -> Word32
script_from_string str :: String
str = String -> Word32
tag_from_string (String -> Word32) -> String -> Word32
forall a b. (a -> b) -> a -> b
$ case ShowS
titlecase String
str of
'Q':'a':'a':'i':_ -> "Zinh"
'Q':'a':'a':'c':_ -> "Copt"
'A':'r':'a':'n':_ -> "Arab"
'C':'y':'r':'s':_ -> "Cyrl"
'G':'e':'o':'k':_ -> "Geor"
'H':'a':'n':'s':_ -> "Hani"
'H':'a':'n':'t':_ -> "Hani"
'J':'a':'m':'o':_ -> "Hang"
'L':'a':'t':'f':_ -> "Latn"
'L':'a':'t':'g':_ -> "Latn"
'S':'y':'r':'e':_ -> "Syrc"
'S':'y':'r':'j':_ -> "Syrc"
'S':'y':'r':'n':_ -> "Syrc"
x :: String
x -> String
x
tag_from_string :: String -> Word32
tag_from_string :: String -> Word32
tag_from_string str :: String
str = case String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. a -> [a]
Prelude.repeat ' ' of
c1 :: Char
c1:c2 :: Char
c2:c3 :: Char
c3:c4 :: Char
c4:_ -> (Word32 -> Word32 -> Word32) -> Word32 -> [Word32] -> Word32
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
(.|.) 0 [
Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL (Char -> Word32
c2w Char
c1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0x7f) 24,
Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL (Char -> Word32
c2w Char
c2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0x7f) 16,
Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL (Char -> Word32
c2w Char
c3 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0x7f) 8,
Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL (Char -> Word32
c2w Char
c4 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0x7f) 0
]
_ -> 0
tag_to_string :: Word32 -> String
tag_to_string :: Word32 -> String
tag_to_string tag :: Word32
tag = [
Word32 -> Char
w2c (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
tag 24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0x7f),
Word32 -> Char
w2c (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
tag 16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0x7f),
Word32 -> Char
w2c (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
tag 8 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0x7f),
Word32 -> Char
w2c (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
tag 0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. 0x7f)
]
c2w :: Char -> Word32
c2w :: Char -> Word32
c2w = Int -> Word32
forall a. Enum a => Int -> a
toEnum (Int -> Word32) -> (Char -> Int) -> Char -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum
w2c :: Word32 -> Char
w2c :: Word32 -> Char
w2c = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word32 -> Int) -> Word32 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a. Enum a => a -> Int
fromEnum
withBuffer :: Buffer -> (Buffer' -> IO a) -> IO a
withBuffer :: Buffer -> (Buffer' -> IO a) -> IO a
withBuffer buf :: Buffer
buf cb :: Buffer' -> IO a
cb = (Buffer' -> IO a) -> IO a
forall a. (Buffer' -> IO a) -> IO a
withNewBuffer ((Buffer' -> IO a) -> IO a) -> (Buffer' -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \buf' :: Buffer'
buf' -> Buffer' -> Text -> IO a -> IO a
forall b. Buffer' -> Text -> IO b -> IO b
bufferWithText Buffer'
buf' (Buffer -> Text
text Buffer
buf) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
Buffer' -> Int -> IO ()
hb_buffer_set_content_type Buffer'
buf' (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ case Buffer -> Maybe ContentType
contentType Buffer
buf of
Nothing -> 0
Just ContentTypeUnicode -> 1
Just ContentTypeGlyphs -> 2
Buffer' -> Int -> IO ()
hb_buffer_set_direction Buffer'
buf' (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Direction -> Int
forall p. Num p => Maybe Direction -> p
dir2int (Maybe Direction -> Int) -> Maybe Direction -> Int
forall a b. (a -> b) -> a -> b
$ Buffer -> Maybe Direction
direction Buffer
buf
case Buffer -> Maybe String
script Buffer
buf of
Just script' :: String
script' -> Buffer' -> Word32 -> IO ()
hb_buffer_set_script Buffer'
buf' (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Word32
script_from_string String
script'
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Buffer -> Maybe String
language Buffer
buf of
Just lang' :: String
lang' -> Buffer' -> Language -> IO ()
hb_buffer_set_language Buffer'
buf' (Language -> IO ()) -> IO Language -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Language
hb_language_from_string String
lang'
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Buffer' -> Int -> IO ()
hb_buffer_set_flags Buffer'
buf' (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.) 0 [
if Buffer -> Bool
beginsText Buffer
buf then 1 else 0,
if Buffer -> Bool
endsText Buffer
buf then 2 else 0,
if Buffer -> Bool
preserveDefaultIgnorables Buffer
buf then 4 else 0,
if Buffer -> Bool
removeDefaultIgnorables Buffer
buf then 8 else 0,
if Buffer -> Bool
don'tInsertDottedCircle Buffer
buf then 16 else 0
]
Buffer' -> Int -> IO ()
hb_buffer_set_cluster_level Buffer'
buf' (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ case Buffer -> ClusterLevel
clusterLevel Buffer
buf of
ClusterMonotoneGraphemes -> 0
ClusterMonotoneChars -> 1
ClusterChars -> 2
Buffer' -> Word32 -> IO ()
hb_buffer_set_invisible_glyph Buffer'
buf' (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ Char -> Word32
c2w (Char -> Word32) -> Char -> Word32
forall a b. (a -> b) -> a -> b
$ Buffer -> Char
invisibleGlyph Buffer
buf
Buffer' -> Word32 -> IO ()
hb_buffer_set_replacement_codepoint Buffer'
buf' (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ Char -> Word32
c2w (Char -> Word32) -> Char -> Word32
forall a b. (a -> b) -> a -> b
$ Buffer -> Char
replacementCodepoint Buffer
buf
Buffer' -> Word32 -> IO ()
hb_buffer_set_not_found_glyph Buffer'
buf' (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ Char -> Word32
c2w (Char -> Word32) -> Char -> Word32
forall a b. (a -> b) -> a -> b
$ Buffer -> Char
notFoundGlyph Buffer
buf
case (Buffer -> Maybe ContentType
contentType Buffer
buf, Buffer -> Maybe Direction
direction Buffer
buf, Buffer -> Maybe String
script Buffer
buf, Buffer -> Maybe String
language Buffer
buf) of
(Just ContentTypeUnicode, Nothing, _, _) -> Buffer' -> IO ()
hb_buffer_guess_segment_properties Buffer'
buf'
(Just ContentTypeUnicode, _, Nothing, _) -> Buffer' -> IO ()
hb_buffer_guess_segment_properties Buffer'
buf'
(Just ContentTypeUnicode, _, _, Nothing) -> Buffer' -> IO ()
hb_buffer_guess_segment_properties Buffer'
buf'
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IO Bool -> IO ()
throwFalse (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Buffer' -> IO Bool
hb_buffer_allocation_successful Buffer'
buf'
Buffer' -> IO a
cb Buffer'
buf'
foreign import ccall "hb_buffer_set_content_type" hb_buffer_set_content_type
:: Buffer' -> Int -> IO ()
foreign import ccall "hb_buffer_set_script" hb_buffer_set_script
:: Buffer' -> Word32 -> IO ()
foreign import ccall "hb_buffer_set_language" hb_buffer_set_language
:: Buffer' -> Language -> IO ()
foreign import ccall "hb_buffer_set_flags" hb_buffer_set_flags :: Buffer' -> Int -> IO ()
foreign import ccall "hb_buffer_set_cluster_level" hb_buffer_set_cluster_level
:: Buffer' -> Int -> IO ()
foreign import ccall "hb_buffer_set_invisible_glyph" hb_buffer_set_invisible_glyph
:: Buffer' -> Word32 -> IO ()
foreign import ccall "hb_buffer_set_replacement_codepoint" hb_buffer_set_replacement_codepoint
:: Buffer' -> Word32 -> IO ()
foreign import ccall "hb_buffer_set_not_found_glyph" hb_buffer_set_not_found_glyph
:: Buffer' -> Word32 -> IO ()
foreign import ccall "hb_buffer_guess_segment_properties" hb_buffer_guess_segment_properties
:: Buffer' -> IO ()
foreign import ccall "hb_buffer_allocation_successful" hb_buffer_allocation_successful
:: Buffer' -> IO Bool
data GlyphInfo = GlyphInfo {
GlyphInfo -> Word32
codepoint :: Word32,
GlyphInfo -> Word32
cluster :: Word32,
GlyphInfo -> Bool
unsafeToBreak :: Bool,
GlyphInfo -> Bool
unsafeToConcat :: Bool,
GlyphInfo -> Bool
safeToInsertTatweel :: Bool
} deriving (Int -> GlyphInfo -> ShowS
[GlyphInfo] -> ShowS
GlyphInfo -> String
(Int -> GlyphInfo -> ShowS)
-> (GlyphInfo -> String)
-> ([GlyphInfo] -> ShowS)
-> Show GlyphInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphInfo] -> ShowS
$cshowList :: [GlyphInfo] -> ShowS
show :: GlyphInfo -> String
$cshow :: GlyphInfo -> String
showsPrec :: Int -> GlyphInfo -> ShowS
$cshowsPrec :: Int -> GlyphInfo -> ShowS
Show, ReadPrec [GlyphInfo]
ReadPrec GlyphInfo
Int -> ReadS GlyphInfo
ReadS [GlyphInfo]
(Int -> ReadS GlyphInfo)
-> ReadS [GlyphInfo]
-> ReadPrec GlyphInfo
-> ReadPrec [GlyphInfo]
-> Read GlyphInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GlyphInfo]
$creadListPrec :: ReadPrec [GlyphInfo]
readPrec :: ReadPrec GlyphInfo
$creadPrec :: ReadPrec GlyphInfo
readList :: ReadS [GlyphInfo]
$creadList :: ReadS [GlyphInfo]
readsPrec :: Int -> ReadS GlyphInfo
$creadsPrec :: Int -> ReadS GlyphInfo
Read, GlyphInfo -> GlyphInfo -> Bool
(GlyphInfo -> GlyphInfo -> Bool)
-> (GlyphInfo -> GlyphInfo -> Bool) -> Eq GlyphInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphInfo -> GlyphInfo -> Bool
$c/= :: GlyphInfo -> GlyphInfo -> Bool
== :: GlyphInfo -> GlyphInfo -> Bool
$c== :: GlyphInfo -> GlyphInfo -> Bool
Eq)
instance Storable GlyphInfo where
sizeOf :: GlyphInfo -> Int
sizeOf _ = Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 5
alignment :: GlyphInfo -> Int
alignment _ = Word32 -> Int
forall a. Storable a => a -> Int
alignment (Word32
forall a. HasCallStack => a
undefined :: Word32)
peek :: Ptr GlyphInfo -> IO GlyphInfo
peek ptr :: Ptr GlyphInfo
ptr = do
let ptr' :: Ptr Word32
ptr' :: Ptr Word32
ptr' = Ptr GlyphInfo -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr GlyphInfo
ptr
Word32
codepoint' <- Ptr Word32
ptr' Ptr Word32 -> Int -> IO Word32
forall a. Storable a => Ptr a -> Int -> IO a
`peekElemOff` 0
Word32
mask <- Ptr Word32
ptr' Ptr Word32 -> Int -> IO Word32
forall a. Storable a => Ptr a -> Int -> IO a
`peekElemOff` 1
Word32
cluster' <- Ptr Word32
ptr' Ptr Word32 -> Int -> IO Word32
forall a. Storable a => Ptr a -> Int -> IO a
`peekElemOff` 2
GlyphInfo -> IO GlyphInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (GlyphInfo -> IO GlyphInfo) -> GlyphInfo -> IO GlyphInfo
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Bool -> Bool -> Bool -> GlyphInfo
GlyphInfo Word32
codepoint' Word32
cluster' (Word32
mask Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` 1) (Word32
mask Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` 2) (Word32
mask Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` 3)
poke :: Ptr GlyphInfo -> GlyphInfo -> IO ()
poke ptr :: Ptr GlyphInfo
ptr (GlyphInfo codepoint' :: Word32
codepoint' cluster' :: Word32
cluster' flag1 :: Bool
flag1 flag2 :: Bool
flag2 flag3 :: Bool
flag3) = do
let ptr' :: Ptr Word32
ptr' :: Ptr Word32
ptr' = Ptr GlyphInfo -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr GlyphInfo
ptr
Ptr Word32 -> Int -> Word32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word32
ptr' 0 Word32
codepoint'
Ptr Word32 -> Int -> Word32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word32
ptr' 1 (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ (Word32 -> Word32 -> Word32) -> Word32 -> [Word32] -> Word32
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
(.|.) 0 [
if Bool
flag1 then 1 else 0,
if Bool
flag2 then 2 else 0,
if Bool
flag3 then 4 else 0
]
Ptr Word32 -> Int -> Word32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word32
ptr' 2 Word32
cluster'
Ptr Word32 -> Int -> Word32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word32
ptr' 3 0
Ptr Word32 -> Int -> Word32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Word32
ptr' 4 0
glyphInfos :: Buffer' -> IO [GlyphInfo]
glyphInfos buf' :: Buffer'
buf' = do
Ptr GlyphInfo
arr <- IO (Ptr GlyphInfo) -> IO (Ptr GlyphInfo)
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr GlyphInfo) -> IO (Ptr GlyphInfo))
-> IO (Ptr GlyphInfo) -> IO (Ptr GlyphInfo)
forall a b. (a -> b) -> a -> b
$ Buffer' -> Ptr Word -> IO (Ptr GlyphInfo)
hb_buffer_get_glyph_infos Buffer'
buf' Ptr Word
forall a. Ptr a
nullPtr
Word
length <- Buffer' -> IO Word
hb_buffer_get_length Buffer'
buf'
if Word
length Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| Ptr GlyphInfo
arr Ptr GlyphInfo -> Ptr GlyphInfo -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr GlyphInfo
forall a. Ptr a
nullPtr
then [GlyphInfo] -> IO [GlyphInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [Int] -> (Int -> IO GlyphInfo) -> IO [GlyphInfo]
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
length Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1] ((Int -> IO GlyphInfo) -> IO [GlyphInfo])
-> (Int -> IO GlyphInfo) -> IO [GlyphInfo]
forall a b. (a -> b) -> a -> b
$ Ptr GlyphInfo -> Int -> IO GlyphInfo
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr GlyphInfo
arr
foreign import ccall "hb_buffer_get_glyph_infos" hb_buffer_get_glyph_infos
:: Buffer' -> Ptr Word -> IO (Ptr GlyphInfo)
foreign import ccall "hb_buffer_get_length" hb_buffer_get_length :: Buffer' -> IO Word
data GlyphPos = GlyphPos {
GlyphPos -> Int32
x_advance :: Int32,
GlyphPos -> Int32
y_advance :: Int32,
GlyphPos -> Int32
x_offset :: Int32,
GlyphPos -> Int32
y_offset :: Int32
} deriving (Int -> GlyphPos -> ShowS
[GlyphPos] -> ShowS
GlyphPos -> String
(Int -> GlyphPos -> ShowS)
-> (GlyphPos -> String) -> ([GlyphPos] -> ShowS) -> Show GlyphPos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphPos] -> ShowS
$cshowList :: [GlyphPos] -> ShowS
show :: GlyphPos -> String
$cshow :: GlyphPos -> String
showsPrec :: Int -> GlyphPos -> ShowS
$cshowsPrec :: Int -> GlyphPos -> ShowS
Show, ReadPrec [GlyphPos]
ReadPrec GlyphPos
Int -> ReadS GlyphPos
ReadS [GlyphPos]
(Int -> ReadS GlyphPos)
-> ReadS [GlyphPos]
-> ReadPrec GlyphPos
-> ReadPrec [GlyphPos]
-> Read GlyphPos
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GlyphPos]
$creadListPrec :: ReadPrec [GlyphPos]
readPrec :: ReadPrec GlyphPos
$creadPrec :: ReadPrec GlyphPos
readList :: ReadS [GlyphPos]
$creadList :: ReadS [GlyphPos]
readsPrec :: Int -> ReadS GlyphPos
$creadsPrec :: Int -> ReadS GlyphPos
Read, GlyphPos -> GlyphPos -> Bool
(GlyphPos -> GlyphPos -> Bool)
-> (GlyphPos -> GlyphPos -> Bool) -> Eq GlyphPos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphPos -> GlyphPos -> Bool
$c/= :: GlyphPos -> GlyphPos -> Bool
== :: GlyphPos -> GlyphPos -> Bool
$c== :: GlyphPos -> GlyphPos -> Bool
Eq, (forall x. GlyphPos -> Rep GlyphPos x)
-> (forall x. Rep GlyphPos x -> GlyphPos) -> Generic GlyphPos
forall x. Rep GlyphPos x -> GlyphPos
forall x. GlyphPos -> Rep GlyphPos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlyphPos x -> GlyphPos
$cfrom :: forall x. GlyphPos -> Rep GlyphPos x
Generic)
instance Storable GlyphPos where
sizeOf :: GlyphPos -> Int
sizeOf _ = Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 5
alignment :: GlyphPos -> Int
alignment _ = Int32 -> Int
forall a. Storable a => a -> Int
alignment (Int32
forall a. HasCallStack => a
undefined :: Int32)
peek :: Ptr GlyphPos -> IO GlyphPos
peek ptr :: Ptr GlyphPos
ptr = let ptr' :: Ptr b
ptr' = Ptr GlyphPos -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr GlyphPos
ptr in do
Int32
x_advance' <- Ptr Int32
forall a. Ptr a
ptr' Ptr Int32 -> Int -> IO Int32
forall a. Storable a => Ptr a -> Int -> IO a
`peekElemOff` 0
Int32
y_advance' <- Ptr Int32
forall a. Ptr a
ptr' Ptr Int32 -> Int -> IO Int32
forall a. Storable a => Ptr a -> Int -> IO a
`peekElemOff` 1
Int32
x_offset' <- Ptr Int32
forall a. Ptr a
ptr' Ptr Int32 -> Int -> IO Int32
forall a. Storable a => Ptr a -> Int -> IO a
`peekElemOff` 2
Int32
y_offset' <- Ptr Int32
forall a. Ptr a
ptr' Ptr Int32 -> Int -> IO Int32
forall a. Storable a => Ptr a -> Int -> IO a
`peekElemOff` 3
GlyphPos -> IO GlyphPos
forall (m :: * -> *) a. Monad m => a -> m a
return (GlyphPos -> IO GlyphPos) -> GlyphPos -> IO GlyphPos
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32 -> Int32 -> Int32 -> GlyphPos
GlyphPos Int32
x_advance' Int32
y_advance' Int32
x_offset' Int32
y_offset'
poke :: Ptr GlyphPos -> GlyphPos -> IO ()
poke ptr :: Ptr GlyphPos
ptr (GlyphPos x_advance' :: Int32
x_advance' y_advance' :: Int32
y_advance' x_offset' :: Int32
x_offset' y_offset' :: Int32
y_offset') = do
let ptr' :: Ptr Int32
ptr' :: Ptr Int32
ptr' = Ptr GlyphPos -> Ptr Int32
forall a b. Ptr a -> Ptr b
castPtr Ptr GlyphPos
ptr
Ptr Int32 -> Int -> Int32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Int32
ptr' 0 Int32
x_advance'
Ptr Int32 -> Int -> Int32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Int32
ptr' 1 Int32
y_advance'
Ptr Int32 -> Int -> Int32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Int32
ptr' 2 Int32
x_offset'
Ptr Int32 -> Int -> Int32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Int32
ptr' 3 Int32
y_offset'
Ptr Int32 -> Int -> Int32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Int32
ptr' 4 0
glyphsPos :: Buffer' -> IO [GlyphPos]
glyphsPos buf' :: Buffer'
buf' = do
Ptr GlyphPos
arr <- IO (Ptr GlyphPos) -> IO (Ptr GlyphPos)
forall a. IO (Ptr a) -> IO (Ptr a)
throwNull (IO (Ptr GlyphPos) -> IO (Ptr GlyphPos))
-> IO (Ptr GlyphPos) -> IO (Ptr GlyphPos)
forall a b. (a -> b) -> a -> b
$ Buffer' -> Ptr Word -> IO (Ptr GlyphPos)
hb_buffer_get_glyph_positions Buffer'
buf' Ptr Word
forall a. Ptr a
nullPtr
Word
length <- Buffer' -> IO Word
hb_buffer_get_length Buffer'
buf'
if Word
length Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| Ptr GlyphPos
arr Ptr GlyphPos -> Ptr GlyphPos -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr GlyphPos
forall a. Ptr a
nullPtr
then [GlyphPos] -> IO [GlyphPos]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [Int] -> (Int -> IO GlyphPos) -> IO [GlyphPos]
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
length Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1] ((Int -> IO GlyphPos) -> IO [GlyphPos])
-> (Int -> IO GlyphPos) -> IO [GlyphPos]
forall a b. (a -> b) -> a -> b
$ Ptr GlyphPos -> Int -> IO GlyphPos
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr GlyphPos
arr
foreign import ccall "hb_buffer_get_glyph_positions" hb_buffer_get_glyph_positions
:: Buffer' -> Ptr Word -> IO (Ptr GlyphPos)
thawBuffer :: Buffer' -> IO Buffer
thawBuffer :: Buffer' -> IO Buffer
thawBuffer buf' :: Buffer'
buf' = do
[GlyphInfo]
glyphInfos' <- Buffer' -> IO [GlyphInfo]
glyphInfos Buffer'
buf'
Int
contentType' <- Buffer' -> IO Int
hb_buffer_get_content_type Buffer'
buf'
Int
direction' <- Buffer' -> IO Int
hb_buffer_get_direction Buffer'
buf'
Word32
script' <- Buffer' -> IO Word32
hb_buffer_get_script Buffer'
buf'
CString
language'' <- Buffer' -> IO CString
hb_buffer_get_language Buffer'
buf'
String
language' <- CString -> IO String
peekCString CString
language''
Int
flags' <- Buffer' -> IO Int
hb_buffer_get_flags Buffer'
buf'
Int
clusterLevel' <- Buffer' -> IO Int
hb_buffer_get_cluster_level Buffer'
buf'
Word32
invisibleGlyph' <- Buffer' -> IO Word32
hb_buffer_get_invisible_glyph Buffer'
buf'
Word32
replacementCodepoint' <- Buffer' -> IO Word32
hb_buffer_get_replacement_codepoint Buffer'
buf'
Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
defaultBuffer {
text :: Text
text = String -> Text
Lazy.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (GlyphInfo -> Char) -> [GlyphInfo] -> String
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (Word32 -> Char
w2c (Word32 -> Char) -> (GlyphInfo -> Word32) -> GlyphInfo -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlyphInfo -> Word32
codepoint) [GlyphInfo]
glyphInfos',
contentType :: Maybe ContentType
contentType = case Int
contentType' of
1 -> ContentType -> Maybe ContentType
forall a. a -> Maybe a
Just ContentType
ContentTypeUnicode
2 -> ContentType -> Maybe ContentType
forall a. a -> Maybe a
Just ContentType
ContentTypeGlyphs
_ -> Maybe ContentType
forall a. Maybe a
Nothing,
direction :: Maybe Direction
direction = Int -> Maybe Direction
forall a. (Eq a, Num a) => a -> Maybe Direction
int2dir Int
direction',
script :: Maybe String
script = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Word32 -> String
tag_to_string Word32
script',
language :: Maybe String
language = String -> Maybe String
forall a. a -> Maybe a
Just String
language',
beginsText :: Bool
beginsText = Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
flags' 0, endsText :: Bool
endsText = Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
flags' 1,
preserveDefaultIgnorables :: Bool
preserveDefaultIgnorables = Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
flags' 2,
removeDefaultIgnorables :: Bool
removeDefaultIgnorables = Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
flags' 3,
don'tInsertDottedCircle :: Bool
don'tInsertDottedCircle = Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
flags' 4,
clusterLevel :: ClusterLevel
clusterLevel = case Int
clusterLevel' of
1 -> ClusterLevel
ClusterMonotoneChars
2 -> ClusterLevel
ClusterChars
_ -> ClusterLevel
ClusterMonotoneGraphemes,
invisibleGlyph :: Char
invisibleGlyph = Word32 -> Char
w2c Word32
invisibleGlyph',
replacementCodepoint :: Char
replacementCodepoint = Word32 -> Char
w2c Word32
replacementCodepoint'
}
foreign import ccall "hb_buffer_get_content_type" hb_buffer_get_content_type
:: Buffer' -> IO Int
foreign import ccall "hb_buffer_get_direction" hb_buffer_get_direction :: Buffer' -> IO Int
foreign import ccall "hb_buffer_get_script" hb_buffer_get_script :: Buffer' -> IO Word32
foreign import ccall "hb_buffer_get_language" hb_buffer_get_language :: Buffer' -> IO CString
foreign import ccall "hb_buffer_get_flags" hb_buffer_get_flags :: Buffer' -> IO Int
foreign import ccall "hb_buffer_get_cluster_level" hb_buffer_get_cluster_level
:: Buffer' -> IO Int
foreign import ccall "hb_buffer_get_invisible_glyph" hb_buffer_get_invisible_glyph
:: Buffer' -> IO Word32
foreign import ccall "hb_buffer_get_replacement_codepoint" hb_buffer_get_replacement_codepoint
:: Buffer' -> IO Word32