{-# 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 Control.DeepSeq (NFData)
import Data.Text.Glyphize.Oom (throwFalse, throwNull)
import Data.Text.Glyphize.Array (iterateLazy, noCache)
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.Marshal.Array (peekArray)
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
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
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]
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
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
Ord)
data ContentType = ContentTypeUnicode | ContentTypeGlyphs deriving (ContentType -> ContentType -> Bool
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
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]
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
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
Ord)
data ClusterLevel = ClusterMonotoneGraphemes | ClusterMonotoneChars | ClusterChars
deriving (ClusterLevel -> ClusterLevel -> Bool
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
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]
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
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
Ord)
defaultBuffer :: Buffer
defaultBuffer = Buffer {
text :: Text
text = Text
Lazy.empty,
contentType :: Maybe ContentType
contentType = forall a. a -> Maybe a
Just ContentType
ContentTypeUnicode,
direction :: Maybe Direction
direction = forall a. Maybe a
Nothing,
script :: Maybe String
script = forall a. Maybe a
Nothing,
language :: Maybe String
language = 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 = Char
' ',
replacementCodepoint :: Char
replacementCodepoint = Char
'\xFFFD',
notFoundGlyph :: Char
notFoundGlyph = Char
'\0'
}
data Direction = DirLTR | DirRTL | DirTTB | DirBTT deriving (Direction -> Direction -> Bool
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
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]
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
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
Ord)
dirFromStr :: String -> Maybe Direction
dirFromStr (Char
'L':String
_) = forall a. a -> Maybe a
Just Direction
DirLTR
dirFromStr (Char
'l':String
_) = forall a. a -> Maybe a
Just Direction
DirLTR
dirFromStr (Char
'R':String
_) = forall a. a -> Maybe a
Just Direction
DirRTL
dirFromStr (Char
'r':String
_) = forall a. a -> Maybe a
Just Direction
DirRTL
dirFromStr (Char
'T':String
_) = forall a. a -> Maybe a
Just Direction
DirTTB
dirFromStr (Char
't':String
_) = forall a. a -> Maybe a
Just Direction
DirTTB
dirFromStr (Char
'B':String
_) = forall a. a -> Maybe a
Just Direction
DirBTT
dirFromStr (Char
'b':String
_) = forall a. a -> Maybe a
Just Direction
DirBTT
dirFromStr String
_ = forall a. Maybe a
Nothing
dirToStr :: Direction -> String
dirToStr Direction
DirLTR = String
"ltr"
dirToStr Direction
DirRTL = String
"rtl"
dirToStr Direction
DirTTB = String
"ttb"
dirToStr Direction
DirBTT = String
"btt"
dirReverse :: Direction -> Direction
dirReverse Direction
DirLTR = Direction
DirRTL
dirReverse Direction
DirRTL = Direction
DirLTR
dirReverse Direction
DirTTB = Direction
DirBTT
dirReverse Direction
DirBTT = Direction
DirTTB
dirBackward :: Direction -> Bool
dirBackward Direction
dir = Direction
dir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Direction
DirRTL, Direction
DirBTT]
dirForward :: Direction -> Bool
dirForward Direction
dir = Direction
dir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Direction
DirLTR, Direction
DirTTB]
dirHorizontal :: Direction -> Bool
dirHorizontal Direction
dir = Direction
dir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Direction
DirLTR, Direction
DirRTL]
dirVertical :: Direction -> Bool
dirVertical Direction
dir = Direction
dir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Direction
DirTTB, Direction
DirBTT]
dir2int :: Maybe Direction -> a
dir2int Maybe Direction
Nothing = a
0
dir2int (Just Direction
DirLTR) = a
4
dir2int (Just Direction
DirRTL) = a
5
dir2int (Just Direction
DirTTB) = a
6
dir2int (Just Direction
DirBTT) = a
7
foreign import ccall "hb_buffer_set_direction" hb_buffer_set_direction
:: Buffer' -> Int -> IO ()
int2dir :: a -> Maybe Direction
int2dir a
4 = forall a. a -> Maybe a
Just Direction
DirLTR
int2dir a
5 = forall a. a -> Maybe a
Just Direction
DirRTL
int2dir a
6 = forall a. a -> Maybe a
Just Direction
DirTTB
int2dir a
7 = forall a. a -> Maybe a
Just Direction
DirBTT
int2dir a
_ = forall a. Maybe a
Nothing
scriptHorizontalDir :: String -> Maybe Direction
scriptHorizontalDir :: String -> Maybe Direction
scriptHorizontalDir = forall {a}. (Eq a, Num a) => a -> Maybe Direction
int2dir forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
hb_script_get_horizontal_direction 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Language -> IO CString
hb_language_to_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 String
str =
forall a. String -> (CString -> IO a) -> IO a
withCString String
str forall a b. (a -> b) -> a -> b
$ \CString
str' -> CString -> Int -> IO Language
hb_language_from_string' CString
str' (-Int
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 :: forall a. (Buffer' -> IO a) -> IO a
withNewBuffer Buffer' -> IO a
cb = 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 Buffer'
_ Text
Lazy.Empty IO b
cb = IO b
cb
bufferWithText Buffer'
buffer txt :: Text
txt@(Lazy.Chunk (Txt.Text (A.ByteArray ByteArray#
arr) Int
offset Int
length) Text
txts) IO b
cb = do
Buffer' -> ByteArray# -> Int# -> Word -> Int -> IO ()
hb_buffer_add_utf8 Buffer'
buffer ByteArray#
arr (ByteArray# -> Int#
sizeofByteArray# ByteArray#
arr) (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 String
"" = String
""
titlecase (Char
c:String
cs) = Char -> Char
toUpper Char
c forall a. a -> [a] -> [a]
: 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 String
str = String -> Word32
tag_from_string forall a b. (a -> b) -> a -> b
$ case ShowS
titlecase String
str of
Char
'Q':Char
'a':Char
'a':Char
'i':String
_ -> String
"Zinh"
Char
'Q':Char
'a':Char
'a':Char
'c':String
_ -> String
"Copt"
Char
'A':Char
'r':Char
'a':Char
'n':String
_ -> String
"Arab"
Char
'C':Char
'y':Char
'r':Char
's':String
_ -> String
"Cyrl"
Char
'G':Char
'e':Char
'o':Char
'k':String
_ -> String
"Geor"
Char
'H':Char
'a':Char
'n':Char
's':String
_ -> String
"Hani"
Char
'H':Char
'a':Char
'n':Char
't':String
_ -> String
"Hani"
Char
'J':Char
'a':Char
'm':Char
'o':String
_ -> String
"Hang"
Char
'L':Char
'a':Char
't':Char
'f':String
_ -> String
"Latn"
Char
'L':Char
'a':Char
't':Char
'g':String
_ -> String
"Latn"
Char
'S':Char
'y':Char
'r':Char
'e':String
_ -> String
"Syrc"
Char
'S':Char
'y':Char
'r':Char
'j':String
_ -> String
"Syrc"
Char
'S':Char
'y':Char
'r':Char
'n':String
_ -> String
"Syrc"
String
x -> String
x
tag_from_string :: String -> Word32
tag_from_string :: String -> Word32
tag_from_string String
str = case String
str forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
Prelude.repeat Char
' ' of
Char
c1:Char
c2:Char
c3:Char
c4:String
_ -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl forall a. Bits a => a -> a -> a
(.|.) Word32
0 [
forall a. Bits a => a -> Int -> a
shiftL (Char -> Word32
c2w Char
c1 forall a. Bits a => a -> a -> a
.&. Word32
0x7f) Int
24,
forall a. Bits a => a -> Int -> a
shiftL (Char -> Word32
c2w Char
c2 forall a. Bits a => a -> a -> a
.&. Word32
0x7f) Int
16,
forall a. Bits a => a -> Int -> a
shiftL (Char -> Word32
c2w Char
c3 forall a. Bits a => a -> a -> a
.&. Word32
0x7f) Int
8,
forall a. Bits a => a -> Int -> a
shiftL (Char -> Word32
c2w Char
c4 forall a. Bits a => a -> a -> a
.&. Word32
0x7f) Int
0
]
String
_ -> Word32
0
tag_to_string :: Word32 -> String
tag_to_string :: Word32 -> String
tag_to_string Word32
tag = [
Word32 -> Char
w2c (forall a. Bits a => a -> Int -> a
shiftR Word32
tag Int
24 forall a. Bits a => a -> a -> a
.&. Word32
0x7f),
Word32 -> Char
w2c (forall a. Bits a => a -> Int -> a
shiftR Word32
tag Int
16 forall a. Bits a => a -> a -> a
.&. Word32
0x7f),
Word32 -> Char
w2c (forall a. Bits a => a -> Int -> a
shiftR Word32
tag Int
8 forall a. Bits a => a -> a -> a
.&. Word32
0x7f),
Word32 -> Char
w2c (forall a. Bits a => a -> Int -> a
shiftR Word32
tag Int
0 forall a. Bits a => a -> a -> a
.&. Word32
0x7f)
]
c2w :: Char -> Word32
c2w :: Char -> Word32
c2w = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
w2c :: Word32 -> Char
w2c :: Word32 -> Char
w2c = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
withBuffer :: Buffer -> (Buffer' -> IO a) -> IO a
withBuffer :: forall a. Buffer -> (Buffer' -> IO a) -> IO a
withBuffer Buffer
buf Buffer' -> IO a
cb = forall a. (Buffer' -> IO a) -> IO a
withNewBuffer forall a b. (a -> b) -> a -> b
$ \Buffer'
buf' -> forall {b}. Buffer' -> Text -> IO b -> IO b
bufferWithText Buffer'
buf' (Buffer -> Text
text Buffer
buf) forall a b. (a -> b) -> a -> b
$ do
Buffer' -> Int -> IO ()
hb_buffer_set_content_type Buffer'
buf' forall a b. (a -> b) -> a -> b
$ case Buffer -> Maybe ContentType
contentType Buffer
buf of
Maybe ContentType
Nothing -> Int
0
Just ContentType
ContentTypeUnicode -> Int
1
Just ContentType
ContentTypeGlyphs -> Int
2
Buffer' -> Int -> IO ()
hb_buffer_set_direction Buffer'
buf' forall a b. (a -> b) -> a -> b
$ forall {a}. Num a => Maybe Direction -> a
dir2int forall a b. (a -> b) -> a -> b
$ Buffer -> Maybe Direction
direction Buffer
buf
case Buffer -> Maybe String
script Buffer
buf of
Just String
script' -> Buffer' -> Word32 -> IO ()
hb_buffer_set_script Buffer'
buf' forall a b. (a -> b) -> a -> b
$ String -> Word32
script_from_string String
script'
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Buffer -> Maybe String
language Buffer
buf of
Just String
lang' -> Buffer' -> Language -> IO ()
hb_buffer_set_language Buffer'
buf' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Language
hb_language_from_string String
lang'
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Buffer' -> Int -> IO ()
hb_buffer_set_flags Buffer'
buf' forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl forall a. Bits a => a -> a -> a
(.|.) Int
0 [
if Buffer -> Bool
beginsText Buffer
buf then Int
1 else Int
0,
if Buffer -> Bool
endsText Buffer
buf then Int
2 else Int
0,
if Buffer -> Bool
preserveDefaultIgnorables Buffer
buf then Int
4 else Int
0,
if Buffer -> Bool
removeDefaultIgnorables Buffer
buf then Int
8 else Int
0,
if Buffer -> Bool
don'tInsertDottedCircle Buffer
buf then Int
16 else Int
0
]
Buffer' -> Int -> IO ()
hb_buffer_set_cluster_level Buffer'
buf' forall a b. (a -> b) -> a -> b
$ case Buffer -> ClusterLevel
clusterLevel Buffer
buf of
ClusterLevel
ClusterMonotoneGraphemes -> Int
0
ClusterLevel
ClusterMonotoneChars -> Int
1
ClusterLevel
ClusterChars -> Int
2
Buffer' -> Word32 -> IO ()
hb_buffer_set_invisible_glyph Buffer'
buf' forall a b. (a -> b) -> a -> b
$ Char -> Word32
c2w forall a b. (a -> b) -> a -> b
$ Buffer -> Char
invisibleGlyph Buffer
buf
Buffer' -> Word32 -> IO ()
hb_buffer_set_replacement_codepoint Buffer'
buf' forall a b. (a -> b) -> a -> b
$ Char -> Word32
c2w forall a b. (a -> b) -> a -> b
$ Buffer -> Char
replacementCodepoint Buffer
buf
Buffer' -> Word32 -> IO ()
hb_buffer_set_not_found_glyph Buffer'
buf' forall a b. (a -> b) -> a -> b
$ Char -> Word32
c2w 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 ContentType
ContentTypeUnicode, Maybe Direction
Nothing, Maybe String
_, Maybe String
_) -> Buffer' -> IO ()
hb_buffer_guess_segment_properties Buffer'
buf'
(Just ContentType
ContentTypeUnicode, Maybe Direction
_, Maybe String
Nothing, Maybe String
_) -> Buffer' -> IO ()
hb_buffer_guess_segment_properties Buffer'
buf'
(Just ContentType
ContentTypeUnicode, Maybe Direction
_, Maybe String
_, Maybe String
Nothing) -> Buffer' -> IO ()
hb_buffer_guess_segment_properties Buffer'
buf'
(Maybe ContentType, Maybe Direction, Maybe String, Maybe String)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
IO Bool -> IO ()
throwFalse 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
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]
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
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, forall x. Rep GlyphInfo x -> GlyphInfo
forall x. GlyphInfo -> Rep GlyphInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlyphInfo x -> GlyphInfo
$cfrom :: forall x. GlyphInfo -> Rep GlyphInfo x
Generic)
instance NFData GlyphInfo
decodeInfos :: [Word32] -> [GlyphInfo]
decodeInfos :: [Word32] -> [GlyphInfo]
decodeInfos (Word32
codepoint':Word32
cluster':Word32
mask:Word32
_:Word32
_:[Word32]
rest) =
Word32 -> Word32 -> Bool -> Bool -> Bool -> GlyphInfo
GlyphInfo Word32
codepoint' Word32
cluster' (Word32
mask forall a. Bits a => a -> Int -> Bool
`testBit` Int
1) (Word32
mask forall a. Bits a => a -> Int -> Bool
`testBit` Int
2)
(Word32
mask forall a. Bits a => a -> Int -> Bool
`testBit` Int
3)forall a. a -> [a] -> [a]
:[Word32] -> [GlyphInfo]
decodeInfos [Word32]
rest
decodeInfos [Word32]
_ = []
glyphInfos :: Buffer' -> IO [GlyphInfo]
glyphInfos Buffer'
buf' = do
Ptr Word32
arr <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ Buffer' -> Ptr Word -> IO (Ptr Word32)
hb_buffer_get_glyph_infos Buffer'
buf' forall a. Ptr a
nullPtr
Word
length <- Buffer' -> IO Word
hb_buffer_get_length Buffer'
buf'
[Word32]
words <- forall a. Storable a => Ptr a -> Int -> IO [a]
iterateLazy Ptr Word32
arr (forall a. Enum a => a -> Int
fromEnum Word
length forall a. Num a => a -> a -> a
* Int
5)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> a -> b
noCache [Word32] -> [GlyphInfo]
decodeInfos [Word32]
words
foreign import ccall "hb_buffer_get_glyph_infos" hb_buffer_get_glyph_infos
:: Buffer' -> Ptr Word -> IO (Ptr Word32)
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
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]
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
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. 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 NFData GlyphPos
decodePositions :: [Int32] -> [GlyphPos]
decodePositions (Int32
x_advance':Int32
y_advance':Int32
x_offset':Int32
y_offset':Int32
_:[Int32]
rest) =
Int32 -> Int32 -> Int32 -> Int32 -> GlyphPos
GlyphPos Int32
x_advance' Int32
y_advance' Int32
x_offset' Int32
y_offset'forall a. a -> [a] -> [a]
:[Int32] -> [GlyphPos]
decodePositions [Int32]
rest
decodePositions [Int32]
_ = []
glyphsPos :: Buffer' -> IO [GlyphPos]
glyphsPos Buffer'
buf' = do
Ptr Int32
arr <- forall a. IO (Ptr a) -> IO (Ptr a)
throwNull forall a b. (a -> b) -> a -> b
$ Buffer' -> Ptr Word -> IO (Ptr Int32)
hb_buffer_get_glyph_positions Buffer'
buf' forall a. Ptr a
nullPtr
Word
length <- Buffer' -> IO Word
hb_buffer_get_length Buffer'
buf'
[Int32]
words <- forall a. Storable a => Ptr a -> Int -> IO [a]
iterateLazy Ptr Int32
arr (forall a. Enum a => a -> Int
fromEnum Word
length forall a. Num a => a -> a -> a
* Int
5)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> a -> b
noCache [Int32] -> [GlyphPos]
decodePositions [Int32]
words
foreign import ccall "hb_buffer_get_glyph_positions" hb_buffer_get_glyph_positions
:: Buffer' -> Ptr Word -> IO (Ptr Int32)
thawBuffer :: Buffer' -> IO Buffer
thawBuffer :: Buffer' -> IO Buffer
thawBuffer 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'
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
defaultBuffer {
text :: Text
text = String -> Text
Lazy.pack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
Prelude.map (Word32 -> Char
w2c forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlyphInfo -> Word32
codepoint) [GlyphInfo]
glyphInfos',
contentType :: Maybe ContentType
contentType = case Int
contentType' of
Int
1 -> forall a. a -> Maybe a
Just ContentType
ContentTypeUnicode
Int
2 -> forall a. a -> Maybe a
Just ContentType
ContentTypeGlyphs
Int
_ -> forall a. Maybe a
Nothing,
direction :: Maybe Direction
direction = forall {a}. (Eq a, Num a) => a -> Maybe Direction
int2dir Int
direction',
script :: Maybe String
script = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word32 -> String
tag_to_string Word32
script',
language :: Maybe String
language = forall a. a -> Maybe a
Just String
language',
beginsText :: Bool
beginsText = forall a. Bits a => a -> Int -> Bool
testBit Int
flags' Int
0, endsText :: Bool
endsText = forall a. Bits a => a -> Int -> Bool
testBit Int
flags' Int
1,
preserveDefaultIgnorables :: Bool
preserveDefaultIgnorables = forall a. Bits a => a -> Int -> Bool
testBit Int
flags' Int
2,
removeDefaultIgnorables :: Bool
removeDefaultIgnorables = forall a. Bits a => a -> Int -> Bool
testBit Int
flags' Int
3,
don'tInsertDottedCircle :: Bool
don'tInsertDottedCircle = forall a. Bits a => a -> Int -> Bool
testBit Int
flags' Int
4,
clusterLevel :: ClusterLevel
clusterLevel = case Int
clusterLevel' of
Int
1 -> ClusterLevel
ClusterMonotoneChars
Int
2 -> ClusterLevel
ClusterChars
Int
_ -> 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