{-# OPTIONS -Wall #-}

module Raylib.Core.Text where

import Foreign
  ( Storable (peek, sizeOf),
    toBool,
  )
import Foreign.C
  ( CUChar,
    peekCString,
    withCString,
  )
import Raylib.ForeignUtil
  ( pop,
    popCArray,
    popCString,
    withFreeableArray2D,
    withFreeable,
    withFreeableArray,
    withFreeableArrayLen,
  )
import Raylib.Internal (addTextureId, unloadSingleTexture, WindowResources)
import Raylib.Native
  ( c'codepointToUTF8,
    c'drawFPS,
    c'drawText,
    c'drawTextCodepoint,
    c'drawTextCodepoints,
    c'drawTextEx,
    c'drawTextPro,
    c'exportFontAsCode,
    c'genImageFontAtlas,
    c'getCodepointCount,
    c'getCodepointNext,
    c'getCodepointPrevious,
    c'getFontDefault,
    c'getGlyphAtlasRec,
    c'getGlyphIndex,
    c'getGlyphInfo,
    c'isFontReady,
    c'loadCodepoints,
    c'loadFont,
    c'loadFontData,
    c'loadFontEx,
    c'loadFontFromImage,
    c'loadFontFromMemory,
    c'loadUTF8,
    c'measureText,
    c'measureTextEx,
  )
import Raylib.Types
  ( Color,
    Font (font'texture),
    FontType,
    GlyphInfo,
    Image,
    Rectangle,
    Texture (texture'id),
    Vector2,
  )

getFontDefault :: IO Font
getFontDefault :: IO Font
getFontDefault = IO (Ptr Font)
c'getFontDefault forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

loadFont :: String -> WindowResources -> IO Font
loadFont :: String -> WindowResources -> IO Font
loadFont String
fileName WindowResources
wr = do
  Font
font <- forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName CString -> IO (Ptr Font)
c'loadFont forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  forall a. Integral a => a -> WindowResources -> IO ()
addTextureId (Texture -> Integer
texture'id forall a b. (a -> b) -> a -> b
$ Font -> Texture
font'texture Font
font) WindowResources
wr
  forall (m :: * -> *) a. Monad m => a -> m a
return Font
font

loadFontEx :: String -> Int -> [Int] -> Int -> WindowResources -> IO Font
loadFontEx :: String -> Int -> [Int] -> Int -> WindowResources -> IO Font
loadFontEx String
fileName Int
fontSize [Int]
fontChars Int
glyphCount WindowResources
wr = do
  Font
font <- forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName (\CString
f -> forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
fontChars) (\Ptr CInt
c -> CString -> CInt -> Ptr CInt -> CInt -> IO (Ptr Font)
c'loadFontEx CString
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize) Ptr CInt
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glyphCount))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  forall a. Integral a => a -> WindowResources -> IO ()
addTextureId (Texture -> Integer
texture'id forall a b. (a -> b) -> a -> b
$ Font -> Texture
font'texture Font
font) WindowResources
wr
  forall (m :: * -> *) a. Monad m => a -> m a
return Font
font

loadFontFromImage :: Image -> Color -> Int -> WindowResources -> IO Font
loadFontFromImage :: Image -> Color -> Int -> WindowResources -> IO Font
loadFontFromImage Image
image Color
key Int
firstChar WindowResources
wr = do
  Font
font <- forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Image
image (\Ptr Image
i -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
key (\Ptr Color
k -> Ptr Image -> Ptr Color -> CInt -> IO (Ptr Font)
c'loadFontFromImage Ptr Image
i Ptr Color
k (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
firstChar))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  forall a. Integral a => a -> WindowResources -> IO ()
addTextureId (Texture -> Integer
texture'id forall a b. (a -> b) -> a -> b
$ Font -> Texture
font'texture Font
font) WindowResources
wr
  forall (m :: * -> *) a. Monad m => a -> m a
return Font
font

loadFontFromMemory :: String -> [Integer] -> Int -> [Int] -> Int -> WindowResources -> IO Font
loadFontFromMemory :: String
-> [Integer] -> Int -> [Int] -> Int -> WindowResources -> IO Font
loadFontFromMemory String
fileType [Integer]
fileData Int
fontSize [Int]
fontChars Int
glyphCount WindowResources
wr = do
  Font
font <- forall a. String -> (CString -> IO a) -> IO a
withCString String
fileType (\CString
t -> forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
fileData) (\Int
size Ptr CUChar
d -> forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
fontChars) (\Ptr CInt
c -> CString
-> Ptr CUChar -> CInt -> CInt -> Ptr CInt -> CInt -> IO (Ptr Font)
c'loadFontFromMemory CString
t Ptr CUChar
d (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
size forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (CUChar
0 :: CUChar)) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize) Ptr CInt
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glyphCount)))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop
  forall a. Integral a => a -> WindowResources -> IO ()
addTextureId (Texture -> Integer
texture'id forall a b. (a -> b) -> a -> b
$ Font -> Texture
font'texture Font
font) WindowResources
wr
  forall (m :: * -> *) a. Monad m => a -> m a
return Font
font

loadFontData :: [Integer] -> Int -> [Int] -> Int -> FontType -> IO GlyphInfo
loadFontData :: [Integer] -> Int -> [Int] -> Int -> FontType -> IO GlyphInfo
loadFontData [Integer]
fileData Int
fontSize [Int]
fontChars Int
glyphCount FontType
fontType = forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
fileData) (\Int
size Ptr CUChar
d -> forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
fontChars) (\Ptr CInt
c -> Ptr CUChar
-> CInt -> CInt -> Ptr CInt -> CInt -> CInt -> IO (Ptr GlyphInfo)
c'loadFontData Ptr CUChar
d (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
size forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (CUChar
0 :: CUChar)) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize) Ptr CInt
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glyphCount) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum FontType
fontType))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

genImageFontAtlas :: [GlyphInfo] -> [[Rectangle]] -> Int -> Int -> Int -> Int -> IO Image
genImageFontAtlas :: [GlyphInfo]
-> [[Rectangle]] -> Int -> Int -> Int -> Int -> IO Image
genImageFontAtlas [GlyphInfo]
chars [[Rectangle]]
recs Int
glyphCount Int
fontSize Int
padding Int
packMethod = forall a b.
(Freeable a, Storable a) =>
[a] -> (Ptr a -> IO b) -> IO b
withFreeableArray [GlyphInfo]
chars (\Ptr GlyphInfo
c -> forall a b.
(Freeable a, Storable a) =>
[[a]] -> (Ptr (Ptr a) -> IO b) -> IO b
withFreeableArray2D [[Rectangle]]
recs (\Ptr (Ptr Rectangle)
r -> Ptr GlyphInfo
-> Ptr (Ptr Rectangle)
-> CInt
-> CInt
-> CInt
-> CInt
-> IO (Ptr Image)
c'genImageFontAtlas Ptr GlyphInfo
c Ptr (Ptr Rectangle)
r (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glyphCount) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
padding) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
packMethod))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

-- | Unloads a font from GPU memory (VRAM). Fonts are automatically unloaded

-- when `closeWindow` is called, so manually unloading fonts is not required.

-- In larger projects, you may want to manually unload fonts to avoid having

-- them in VRAM for too long.

unloadFont :: Font -> WindowResources -> IO ()
unloadFont :: Font -> WindowResources -> IO ()
unloadFont Font
font = forall a. Integral a => a -> WindowResources -> IO ()
unloadSingleTexture (Texture -> Integer
texture'id forall a b. (a -> b) -> a -> b
$ Font -> Texture
font'texture Font
font)

isFontReady :: Font -> IO Bool
isFontReady :: Font -> IO Bool
isFontReady Font
font = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font Ptr Font -> IO CBool
c'isFontReady

exportFontAsCode :: Font -> String -> IO Bool
exportFontAsCode :: Font -> String -> IO Bool
exportFontAsCode Font
font String
fileName = forall a. (Eq a, Num a) => a -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font (forall a. String -> (CString -> IO a) -> IO a
withCString String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font -> CString -> IO CBool
c'exportFontAsCode)

drawFPS :: Int -> Int -> IO ()
drawFPS :: Int -> Int -> IO ()
drawFPS Int
x Int
y = CInt -> CInt -> IO ()
c'drawFPS (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

drawText :: String -> Int -> Int -> Int -> Color -> IO ()
drawText :: String -> Int -> Int -> Int -> Color -> IO ()
drawText String
text Int
x Int
y Int
fontSize Color
color = forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
color (CString -> CInt -> CInt -> CInt -> Ptr Color -> IO ()
c'drawText CString
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize)))

drawTextEx :: Font -> String -> Vector2 -> Float -> Float -> Color -> IO ()
drawTextEx :: Font -> String -> Vector2 -> Float -> Float -> Color -> IO ()
drawTextEx Font
font String
text Vector2
position Float
fontSize Float
spacing Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font (\Ptr Font
f -> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Font
-> CString -> Ptr Vector2 -> CFloat -> CFloat -> Ptr Color -> IO ()
c'drawTextEx Ptr Font
f CString
t Ptr Vector2
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
fontSize) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spacing)))))

drawTextPro :: Font -> String -> Vector2 -> Vector2 -> Float -> Float -> Float -> Color -> IO ()
drawTextPro :: Font
-> String
-> Vector2
-> Vector2
-> Float
-> Float
-> Float
-> Color
-> IO ()
drawTextPro Font
font String
text Vector2
position Vector2
origin Float
rotation Float
fontSize Float
spacing Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font (\Ptr Font
f -> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
origin (\Ptr Vector2
o -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Font
-> CString
-> Ptr Vector2
-> Ptr Vector2
-> CFloat
-> CFloat
-> CFloat
-> Ptr Color
-> IO ()
c'drawTextPro Ptr Font
f CString
t Ptr Vector2
p Ptr Vector2
o (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rotation) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
fontSize) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spacing))))))

drawTextCodepoint :: Font -> Int -> Vector2 -> Float -> Color -> IO ()
drawTextCodepoint :: Font -> Int -> Vector2 -> Float -> Color -> IO ()
drawTextCodepoint Font
font Int
codepoint Vector2
position Float
fontSize Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font (\Ptr Font
f -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Font -> CInt -> Ptr Vector2 -> CFloat -> Ptr Color -> IO ()
c'drawTextCodepoint Ptr Font
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
codepoint) Ptr Vector2
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
fontSize))))

drawTextCodepoints :: Font -> [Int] -> Vector2 -> Float -> Float -> Color -> IO ()
drawTextCodepoints :: Font -> [Int] -> Vector2 -> Float -> Float -> Color -> IO ()
drawTextCodepoints Font
font [Int]
codepoints Vector2
position Float
fontSize Float
spacing Color
tint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font (\Ptr Font
f -> forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
codepoints) (\Int
count Ptr CInt
cp -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Vector2
position (\Ptr Vector2
p -> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Color
tint (Ptr Font
-> Ptr CInt
-> CInt
-> Ptr Vector2
-> CFloat
-> CFloat
-> Ptr Color
-> IO ()
c'drawTextCodepoints Ptr Font
f Ptr CInt
cp (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count) Ptr Vector2
p (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
fontSize) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spacing)))))

measureText :: String -> Int -> IO Int
measureText :: String -> Int -> IO Int
measureText String
text Int
fontSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> CString -> CInt -> IO CInt
c'measureText CString
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fontSize))

measureTextEx :: Font -> String -> Float -> Float -> IO Vector2
measureTextEx :: Font -> String -> Float -> Float -> IO Vector2
measureTextEx Font
font String
text Float
fontSize Float
spacing = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font (\Ptr Font
f -> forall a. String -> (CString -> IO a) -> IO a
withCString String
text (\CString
t -> Ptr Font -> CString -> CFloat -> CFloat -> IO (Ptr Vector2)
c'measureTextEx Ptr Font
f CString
t (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
fontSize) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
spacing))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getGlyphIndex :: Font -> Int -> IO Int
getGlyphIndex :: Font -> Int -> IO Int
getGlyphIndex Font
font Int
codepoint = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font (\Ptr Font
f -> Ptr Font -> CInt -> IO CInt
c'getGlyphIndex Ptr Font
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
codepoint))

getGlyphInfo :: Font -> Int -> IO GlyphInfo
getGlyphInfo :: Font -> Int -> IO GlyphInfo
getGlyphInfo Font
font Int
codepoint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font (\Ptr Font
f -> Ptr Font -> CInt -> IO (Ptr GlyphInfo)
c'getGlyphInfo Ptr Font
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
codepoint)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

getGlyphAtlasRec :: Font -> Int -> IO Rectangle
getGlyphAtlasRec :: Font -> Int -> IO Rectangle
getGlyphAtlasRec Font
font Int
codepoint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable Font
font (\Ptr Font
f -> Ptr Font -> CInt -> IO (Ptr Rectangle)
c'getGlyphAtlasRec Ptr Font
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
codepoint)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Freeable a, Storable a) => Ptr a -> IO a
pop

loadUTF8 :: [Integer] -> IO String
loadUTF8 :: [Integer] -> IO String
loadUTF8 [Integer]
codepoints =
  forall a b.
(Freeable a, Storable a) =>
[a] -> (Int -> Ptr a -> IO b) -> IO b
withFreeableArrayLen
    (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
codepoints)
    ( \Int
size Ptr CInt
c ->
        Ptr CInt -> CInt -> IO CString
c'loadUTF8 Ptr CInt
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
    )
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
popCString

loadCodepoints :: String -> IO [Int]
loadCodepoints :: String -> IO [Int]
loadCodepoints String
text =
  forall a. String -> (CString -> IO a) -> IO a
withCString
    String
text
    ( \CString
t ->
        forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          CInt
0
          ( \Ptr CInt
n -> do
              Ptr CInt
res <- CString -> Ptr CInt -> IO (Ptr CInt)
c'loadCodepoints CString
t Ptr CInt
n
              CInt
num <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
n
              forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Freeable a, Storable a) => Int -> Ptr a -> IO [a]
popCArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
num) Ptr CInt
res
          )
    )

getCodepointCount :: String -> IO Int
getCodepointCount :: String -> IO Int
getCodepointCount String
text = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> (CString -> IO a) -> IO a
withCString String
text CString -> IO CInt
c'getCodepointCount

getCodepointNext :: String -> IO (Int, Int)
getCodepointNext :: String -> IO (Int, Int)
getCodepointNext String
text =
  forall a. String -> (CString -> IO a) -> IO a
withCString
    String
text
    ( \CString
t ->
        forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          CInt
0
          ( \Ptr CInt
n ->
              do
                CInt
res <- CString -> Ptr CInt -> IO CInt
c'getCodepointNext CString
t Ptr CInt
n
                CInt
num <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
n
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res, forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
num)
          )
    )

getCodepointPrevious :: String -> IO (Int, Int)
getCodepointPrevious :: String -> IO (Int, Int)
getCodepointPrevious String
text =
  forall a. String -> (CString -> IO a) -> IO a
withCString
    String
text
    ( \CString
t ->
        forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable
          CInt
0
          ( \Ptr CInt
n ->
              do
                CInt
res <- CString -> Ptr CInt -> IO CInt
c'getCodepointPrevious CString
t Ptr CInt
n
                CInt
num <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
n
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res, forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
num)
          )
    )

codepointToUTF8 :: Int -> IO String
codepointToUTF8 :: Int -> IO String
codepointToUTF8 Int
codepoint = forall a b.
(Freeable a, Storable a) =>
a -> (Ptr a -> IO b) -> IO b
withFreeable CInt
0 (CInt -> Ptr CInt -> IO CString
c'codepointToUTF8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
codepoint) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString