-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Monomer/Graphics/FFI.chs" #-}
{-|
Module      : Monomer.Graphics.FFI
Copyright   : (c) 2018 Francisco Vallarino,
              (c) 2016 Moritz Kiefer
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Provides functions for getting text dimensions and metrics.

Based on code from cocreature's https://github.com/cocreature/nanovg-hs
-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

module Monomer.Graphics.FFI where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import Control.Monad (forM, (>=>))
import Data.ByteString (useAsCStringLen, useAsCString, ByteString)
import Data.Text (Text)
import Data.Text.Foreign (withCStringLen)
import Data.Sequence (Seq)
import Foreign
import Foreign.C (CString)
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable

import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

import Monomer.Graphics.Types (GlyphPos(..))



-- | Vector of 4 strict elements.
data V4 a = V4 !a !a !a !a
  deriving (Int -> V4 a -> ShowS
forall a. Show a => Int -> V4 a -> ShowS
forall a. Show a => [V4 a] -> ShowS
forall a. Show a => V4 a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [V4 a] -> ShowS
$cshowList :: forall a. Show a => [V4 a] -> ShowS
show :: V4 a -> String
$cshow :: forall a. Show a => V4 a -> String
showsPrec :: Int -> V4 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> V4 a -> ShowS
Show, ReadPrec [V4 a]
ReadPrec (V4 a)
ReadS [V4 a]
forall a. Read a => ReadPrec [V4 a]
forall a. Read a => ReadPrec (V4 a)
forall a. Read a => Int -> ReadS (V4 a)
forall a. Read a => ReadS [V4 a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [V4 a]
$creadListPrec :: forall a. Read a => ReadPrec [V4 a]
readPrec :: ReadPrec (V4 a)
$creadPrec :: forall a. Read a => ReadPrec (V4 a)
readList :: ReadS [V4 a]
$creadList :: forall a. Read a => ReadS [V4 a]
readsPrec :: Int -> ReadS (V4 a)
$creadsPrec :: forall a. Read a => Int -> ReadS (V4 a)
Read, V4 a -> V4 a -> Bool
forall a. Eq a => V4 a -> V4 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V4 a -> V4 a -> Bool
$c/= :: forall a. Eq a => V4 a -> V4 a -> Bool
== :: V4 a -> V4 a -> Bool
$c== :: forall a. Eq a => V4 a -> V4 a -> Bool
Eq, V4 a -> V4 a -> Bool
V4 a -> V4 a -> Ordering
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
forall {a}. Ord a => Eq (V4 a)
forall a. Ord a => V4 a -> V4 a -> Bool
forall a. Ord a => V4 a -> V4 a -> Ordering
forall a. Ord a => V4 a -> V4 a -> V4 a
min :: V4 a -> V4 a -> V4 a
$cmin :: forall a. Ord a => V4 a -> V4 a -> V4 a
max :: V4 a -> V4 a -> V4 a
$cmax :: forall a. Ord a => V4 a -> V4 a -> V4 a
>= :: V4 a -> V4 a -> Bool
$c>= :: forall a. Ord a => V4 a -> V4 a -> Bool
> :: V4 a -> V4 a -> Bool
$c> :: forall a. Ord a => V4 a -> V4 a -> Bool
<= :: V4 a -> V4 a -> Bool
$c<= :: forall a. Ord a => V4 a -> V4 a -> Bool
< :: V4 a -> V4 a -> Bool
$c< :: forall a. Ord a => V4 a -> V4 a -> Bool
compare :: V4 a -> V4 a -> Ordering
$ccompare :: forall a. Ord a => V4 a -> V4 a -> Ordering
Ord)

-- | Bounds of a block of text.
newtype Bounds
  = Bounds (V4 CFloat)
  deriving (Int -> Bounds -> ShowS
[Bounds] -> ShowS
Bounds -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bounds] -> ShowS
$cshowList :: [Bounds] -> ShowS
show :: Bounds -> String
$cshow :: Bounds -> String
showsPrec :: Int -> Bounds -> ShowS
$cshowsPrec :: Int -> Bounds -> ShowS
Show, ReadPrec [Bounds]
ReadPrec Bounds
Int -> ReadS Bounds
ReadS [Bounds]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Bounds]
$creadListPrec :: ReadPrec [Bounds]
readPrec :: ReadPrec Bounds
$creadPrec :: ReadPrec Bounds
readList :: ReadS [Bounds]
$creadList :: ReadS [Bounds]
readsPrec :: Int -> ReadS Bounds
$creadsPrec :: Int -> ReadS Bounds
Read, Bounds -> Bounds -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bounds -> Bounds -> Bool
$c/= :: Bounds -> Bounds -> Bool
== :: Bounds -> Bounds -> Bool
$c== :: Bounds -> Bounds -> Bool
Eq, Eq Bounds
Bounds -> Bounds -> Bool
Bounds -> Bounds -> Ordering
Bounds -> Bounds -> Bounds
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 :: Bounds -> Bounds -> Bounds
$cmin :: Bounds -> Bounds -> Bounds
max :: Bounds -> Bounds -> Bounds
$cmax :: Bounds -> Bounds -> Bounds
>= :: Bounds -> Bounds -> Bool
$c>= :: Bounds -> Bounds -> Bool
> :: Bounds -> Bounds -> Bool
$c> :: Bounds -> Bounds -> Bool
<= :: Bounds -> Bounds -> Bool
$c<= :: Bounds -> Bounds -> Bool
< :: Bounds -> Bounds -> Bool
$c< :: Bounds -> Bounds -> Bool
compare :: Bounds -> Bounds -> Ordering
$ccompare :: Bounds -> Bounds -> Ordering
Ord)

instance Storable Bounds where
  sizeOf :: Bounds -> Int
sizeOf Bounds
_ = forall a. Storable a => a -> Int
sizeOf (CFloat
0 :: CFloat) forall a. Num a => a -> a -> a
* Int
4
  alignment :: Bounds -> Int
alignment Bounds
_ = forall a. Storable a => a -> Int
alignment (CFloat
0 :: CFloat)
  peek :: Ptr Bounds -> IO Bounds
peek Ptr Bounds
p =
    do let p' :: Ptr CFloat
p' = forall a b. Ptr a -> Ptr b
castPtr Ptr Bounds
p :: Ptr CFloat
       CFloat
a <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CFloat
p' Int
0
       CFloat
b <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CFloat
p' Int
1
       CFloat
c <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CFloat
p' Int
2
       CFloat
d <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CFloat
p' Int
3
       forall (f :: * -> *) a. Applicative f => a -> f a
pure (V4 CFloat -> Bounds
Bounds (forall a. a -> a -> a -> a -> V4 a
V4 CFloat
a CFloat
b CFloat
c CFloat
d))
  poke :: Ptr Bounds -> Bounds -> IO ()
poke Ptr Bounds
p (Bounds (V4 CFloat
a CFloat
b CFloat
c CFloat
d)) =
    do let p' :: Ptr CFloat
p' = forall a b. Ptr a -> Ptr b
castPtr Ptr Bounds
p :: Ptr CFloat
       forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CFloat
p' Int
0 CFloat
a
       forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CFloat
p' Int
1 CFloat
b
       forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CFloat
p' Int
2 CFloat
c
       forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CFloat
p' Int
3 CFloat
d

-- | Position of a glyph in a text string.
data GlyphPosition = GlyphPosition {
  -- | Pointer of the glyph in the input string.
  GlyphPosition -> Ptr CChar
str :: !(Ptr CChar),
  -- | The x-coordinate of the logical glyph position.
  GlyphPosition -> CFloat
glyphX :: !CFloat,
  -- | The left bound of the glyph shape.
  GlyphPosition -> CFloat
glyphPosMinX :: !CFloat,
  -- | The right bound of the glyph shape.
  GlyphPosition -> CFloat
glyphPosMaxX :: !CFloat,
  -- | The lower bound of the glyph shape.
  GlyphPosition -> CFloat
glyphPosMinY :: !CFloat,
  -- | The upper bound of the glyph shape.
  GlyphPosition -> CFloat
glyphPosMaxY :: !CFloat
} deriving (Show, Eq, Ord)

instance Storable GlyphPosition where
  sizeOf _ = 32
{-# LINE 83 "src/Monomer/Graphics/FFI.chs" #-}

  alignment _ = 8
{-# LINE 84 "src/Monomer/Graphics/FFI.chs" #-}

  peek p =
    do str <- (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) p
       x <- (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CFloat}) p
       minx <- (\ptr -> do {C2HSImp.peekByteOff ptr 12 :: IO C2HSImp.CFloat}) p
       maxx <- (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CFloat}) p
       miny <- (\ptr -> do {C2HSImp.peekByteOff ptr 20 :: IO C2HSImp.CFloat}) p
       maxy <- (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO C2HSImp.CFloat}) p
       pure (GlyphPosition str x minx maxx miny maxy)
  poke :: Ptr GlyphPosition -> GlyphPosition -> IO ()
poke Ptr GlyphPosition
p (GlyphPosition Ptr CChar
str CFloat
x CFloat
minx CFloat
maxx CFloat
miny CFloat
maxy) =
    do (\Ptr GlyphPosition
ptr Ptr CChar
val -> do {forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr GlyphPosition
ptr Int
0 (Ptr CChar
val :: (C2HSImp.Ptr C2HSImp.CChar))}) Ptr GlyphPosition
p Ptr CChar
str
       (\Ptr GlyphPosition
ptr CFloat
val -> do {forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr GlyphPosition
ptr Int
8 (CFloat
val :: C2HSImp.CFloat)}) Ptr GlyphPosition
p CFloat
x
       (\Ptr GlyphPosition
ptr CFloat
val -> do {forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr GlyphPosition
ptr Int
12 (CFloat
val :: C2HSImp.CFloat)}) Ptr GlyphPosition
p CFloat
minx
       (\Ptr GlyphPosition
ptr CFloat
val -> do {forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr GlyphPosition
ptr Int
16 (CFloat
val :: C2HSImp.CFloat)}) Ptr GlyphPosition
p CFloat
maxx
       (\Ptr GlyphPosition
ptr CFloat
val -> do {forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr GlyphPosition
ptr Int
20 (CFloat
val :: C2HSImp.CFloat)}) Ptr GlyphPosition
p CFloat
miny
       (\Ptr GlyphPosition
ptr CFloat
val -> do {forall a b. Storable a => Ptr b -> Int -> a -> IO ()
C2HSImp.pokeByteOff Ptr GlyphPosition
ptr Int
24 (CFloat
val :: C2HSImp.CFloat)}) Ptr GlyphPosition
p CFloat
maxy

type GlyphPositionPtr = C2HSImp.Ptr (GlyphPosition)
{-# LINE 101 "src/Monomer/Graphics/FFI.chs" #-}


-- | Reads Bounds from a pointer.
peekBounds :: Ptr CFloat -> IO Bounds
peekBounds :: Ptr CFloat -> IO Bounds
peekBounds = forall a. Storable a => Ptr a -> IO a
peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr

-- | Allocates space for Bounds.
allocaBounds :: (Ptr CFloat -> IO b) -> IO b
allocaBounds :: forall b. (Ptr CFloat -> IO b) -> IO b
allocaBounds Ptr CFloat -> IO b
f = forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\(Ptr Bounds
p :: Ptr Bounds) -> Ptr CFloat -> IO b
f (forall a b. Ptr a -> Ptr b
castPtr Ptr Bounds
p))

withCString :: Text -> (CString -> IO b) -> IO b
withCString :: forall b. Text -> (Ptr CChar -> IO b) -> IO b
withCString Text
t = forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
useAsCString (Text -> ByteString
T.encodeUtf8 Text
t)

withText :: Text -> (CString -> IO b) -> IO b
withText :: forall b. Text -> (Ptr CChar -> IO b) -> IO b
withText Text
t = forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
useAsCString (Text -> ByteString
T.encodeUtf8 Text
t)

-- | Marshalling helper for a constant 'nullPtr'
withNull :: (Ptr a -> b) -> b
withNull :: forall a b. (Ptr a -> b) -> b
withNull Ptr a -> b
f = Ptr a -> b
f forall a. Ptr a
nullPtr

-- | Same as CStringLen, but for strings of unsigned char* array type.
type CUStringLen = (Ptr CUChar, CInt)

-- | Same as 'useAsCStringLen', but works with unsigned char* arrays.
useAsCUStringLen :: ByteString -> (CUStringLen -> IO a) -> IO a
useAsCUStringLen :: forall a. ByteString -> (CUStringLen -> IO a) -> IO a
useAsCUStringLen ByteString
bs CUStringLen -> IO a
f = forall a. ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen ByteString
bs (\(Ptr CChar
ptr, Int
len) -> CUStringLen -> IO a
f (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))

-- | Same as 'useAsCUStringLen', but copies the underlying memory, leaving freeing it to the C code.
allocCUStringLen :: ByteString -> (CUStringLen -> IO a) -> IO a
allocCUStringLen :: forall a. ByteString -> (CUStringLen -> IO a) -> IO a
allocCUStringLen ByteString
bs CUStringLen -> IO a
f = forall a. ByteString -> (CUStringLen -> IO a) -> IO a
useAsCUStringLen ByteString
bs (CUStringLen -> IO CUStringLen
copyCUStringLenMemory forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CUStringLen -> IO a
f)

-- | Copy memory under given pointer to a new address.
-- The allocated memory is not garbage-collected and needs to be freed manually later.
copyCUStringLenMemory :: CUStringLen -> IO CUStringLen
copyCUStringLenMemory :: CUStringLen -> IO CUStringLen
copyCUStringLenMemory (Ptr CUChar
from, CInt
len) =
  let intLen :: Int
intLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
len
  in do
    Ptr CUChar
to <- forall a. Int -> IO (Ptr a)
mallocBytes Int
intLen
    forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr CUChar
to Ptr CUChar
from Int
intLen
    forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CUChar
to, CInt
len)

-- Common
newtype FMContext = FMContext (C2HSImp.Ptr (FMContext))
{-# LINE 143 "src/Monomer/Graphics/FFI.chs" #-}

deriving instance Storable FMContext

fmInit :: (Double) -> IO ((FMContext))
fmInit :: Double -> IO FMContext
fmInit Double
a1 =
  let {a1' :: CFloat
a1' = forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
a1} in 
  CFloat -> IO FMContext
fmInit'_ CFloat
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FMContext
res ->
  let {res' :: FMContext
res' = forall a. a -> a
id FMContext
res} in
  return (res')

{-# LINE 146 "src/Monomer/Graphics/FFI.chs" #-}


fmCreateFont :: (FMContext) -> (Text) -> (Text) -> IO ((Int))
fmCreateFont a1 a2 a3 =
  let {a1' = id a1} in 
  withCString a2 $ \a2' -> 
  withCString a3 $ \a3' -> 
  fmCreateFont'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 148 "src/Monomer/Graphics/FFI.chs" #-}


fmCreateFontMem :: (FMContext) -> (Text) -> (ByteString) -> IO ((Int))
fmCreateFontMem a1 a2 a3 =
  let {a1' = id a1} in 
  withCString a2 $ \a2' -> 
  allocCUStringLen a3 $ \(a3'1, a3'2) -> 
  fmCreateFontMem'_ a1' a2' a3'1  a3'2 >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 150 "src/Monomer/Graphics/FFI.chs" #-}


fmSetScale :: (FMContext) -> (Double) -> IO ()
fmSetScale a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  fmSetScale'_ a1' a2' >>
  return ()

{-# LINE 152 "src/Monomer/Graphics/FFI.chs" #-}


fmFontFace :: (FMContext) -> (Text) -> IO ()
fmFontFace a1 a2 =
  let {a1' = id a1} in 
  withCString a2 $ \a2' -> 
  fmFontFace'_ a1' a2' >>
  return ()

{-# LINE 154 "src/Monomer/Graphics/FFI.chs" #-}


fmFontSize :: (FMContext) -> (Double) -> IO ()
fmFontSize a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  fmFontSize'_ a1' a2' >>
  return ()

{-# LINE 156 "src/Monomer/Graphics/FFI.chs" #-}


fmFontBlur :: (FMContext) -> (Double) -> IO ()
fmFontBlur a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  fmFontBlur'_ a1' a2' >>
  return ()

{-# LINE 158 "src/Monomer/Graphics/FFI.chs" #-}


fmTextLetterSpacing :: (FMContext) -> (Double) -> IO ()
fmTextLetterSpacing a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  fmTextLetterSpacing'_ a1' a2' >>
  return ()

{-# LINE 160 "src/Monomer/Graphics/FFI.chs" #-}


fmTextLineHeight :: (FMContext) -> (Double) -> IO ()
fmTextLineHeight a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  fmTextLineHeight'_ a1' a2' >>
  return ()

{-# LINE 162 "src/Monomer/Graphics/FFI.chs" #-}


fmTextMetrics_ :: (FMContext) -> IO ((CFloat), (CFloat), (CFloat))
fmTextMetrics_ a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  fmTextMetrics_'_ a1' a2' a3' a4' >>
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  peek  a4'>>= \a4'' -> 
  return (a2'', a3'', a4'')

{-# LINE 164 "src/Monomer/Graphics/FFI.chs" #-}


fmTextMetrics :: FMContext -> IO (Double, Double, Double)
fmTextMetrics fm = do
  (asc, desc, lineh) <- fmTextMetrics_ fm
  return (realToFrac asc, realToFrac desc, realToFrac lineh)

fmTextBounds_ :: (FMContext) -> (Double) -> (Double) -> (Text) -> IO ((Double), (Bounds))
fmTextBounds_ a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  withText a4 $ \a4' -> 
  withNull $ \a5' -> 
  allocaBounds $ \a6' -> 
  fmTextBounds_'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = realToFrac res} in
  peekBounds  a6'>>= \a6'' -> 
  return (res', a6'')

{-# LINE 172 "src/Monomer/Graphics/FFI.chs" #-}


fmTextBounds :: FMContext -> Double -> Double -> Text -> IO (Double, Double, Double, Double)
fmTextBounds fm x y text = do
  (_, Bounds (V4 x1 y1 x2 y2)) <- fmTextBounds_ fm x y text
  return (realToFrac x1, realToFrac y1, realToFrac x2, realToFrac y2)

fmTextGlyphPositions_ :: (FMContext) -> (Double) -> (Double) -> (Ptr CChar) -> (Ptr CChar) -> (GlyphPositionPtr) -> (CInt) -> IO ((CInt))
fmTextGlyphPositions_ a1 a2 a3 a4 a5 a6 a7 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  let {a4' = id a4} in 
  let {a5' = id a5} in 
  let {a6' = id a6} in 
  let {a7' = fromIntegral a7} in 
  fmTextGlyphPositions_'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 180 "src/Monomer/Graphics/FFI.chs" #-}


fmTextGlyphPositions :: FMContext -> Double -> Double -> Text -> IO (Seq GlyphPosition)
fmTextGlyphPositions c x y text =
  withCStringLen text $ \(ptr, len) -> do
    let startPtr = ptr
    let endPtr = ptr `plusPtr` len
    allocaBytesAligned bufferSize align $ \arrayPtr -> do
      count <- fmTextGlyphPositions_ c x y startPtr endPtr arrayPtr maxGlyphs
      Seq.fromList <$> readChunk arrayPtr count
  where
    maxGlyphs = fromIntegral (T.length text)
    bufferSize = sizeOf (undefined :: GlyphPosition) * fromIntegral maxGlyphs
    align = alignment (undefined :: GlyphPosition)
    readChunk :: GlyphPositionPtr -> CInt -> IO [GlyphPosition]
    readChunk arrayPtr count = forM [0..count-1] $ \i ->
      peekElemOff arrayPtr (fromIntegral i)

foreign import ccall unsafe "Monomer/Graphics/FFI.chs.h fmInit"
  fmInit'_ :: (C2HSImp.CFloat -> (IO (FMContext)))

foreign import ccall unsafe "Monomer/Graphics/FFI.chs.h fmCreateFont"
  fmCreateFont'_ :: ((FMContext) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Monomer/Graphics/FFI.chs.h fmCreateFontMem"
  fmCreateFontMem'_ :: ((FMContext) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Monomer/Graphics/FFI.chs.h fmSetScale"
  fmSetScale'_ :: ((FMContext) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "Monomer/Graphics/FFI.chs.h fmFontFace"
  fmFontFace'_ :: ((FMContext) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))

foreign import ccall unsafe "Monomer/Graphics/FFI.chs.h fmFontSize"
  fmFontSize'_ :: ((FMContext) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "Monomer/Graphics/FFI.chs.h fmFontBlur"
  fmFontBlur'_ :: ((FMContext) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "Monomer/Graphics/FFI.chs.h fmTextLetterSpacing"
  fmTextLetterSpacing'_ :: ((FMContext) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "Monomer/Graphics/FFI.chs.h fmTextLineHeight"
  fmTextLineHeight'_ :: ((FMContext) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "Monomer/Graphics/FFI.chs.h fmTextMetrics"
  fmTextMetrics_'_ :: ((FMContext) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (IO ())))))

foreign import ccall unsafe "Monomer/Graphics/FFI.chs.h fmTextBounds"
  fmTextBounds_'_ :: ((FMContext) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (IO C2HSImp.CFloat)))))))

foreign import ccall unsafe "Monomer/Graphics/FFI.chs.h fmTextGlyphPositions"
  fmTextGlyphPositions_'_ :: ((FMContext) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((GlyphPositionPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))))