-- GENERATED by C->Haskell Compiler, version 0.28.7 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 (useAsCString)
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
[V4 a] -> ShowS
V4 a -> String
(Int -> V4 a -> ShowS)
-> (V4 a -> String) -> ([V4 a] -> ShowS) -> Show (V4 a)
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)
Int -> ReadS (V4 a)
ReadS [V4 a]
(Int -> ReadS (V4 a))
-> ReadS [V4 a]
-> ReadPrec (V4 a)
-> ReadPrec [V4 a]
-> Read (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
(V4 a -> V4 a -> Bool) -> (V4 a -> V4 a -> Bool) -> Eq (V4 a)
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, Eq (V4 a)
Eq (V4 a)
-> (V4 a -> V4 a -> Ordering)
-> (V4 a -> V4 a -> Bool)
-> (V4 a -> V4 a -> Bool)
-> (V4 a -> V4 a -> Bool)
-> (V4 a -> V4 a -> Bool)
-> (V4 a -> V4 a -> V4 a)
-> (V4 a -> V4 a -> V4 a)
-> Ord (V4 a)
V4 a -> V4 a -> Bool
V4 a -> V4 a -> Ordering
V4 a -> V4 a -> V4 a
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
$cp1Ord :: forall a. Ord a => Eq (V4 a)
Ord)

newtype Bounds
  = Bounds (V4 CFloat)
  deriving (Int -> Bounds -> ShowS
[Bounds] -> ShowS
Bounds -> String
(Int -> Bounds -> ShowS)
-> (Bounds -> String) -> ([Bounds] -> ShowS) -> Show Bounds
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]
(Int -> ReadS Bounds)
-> ReadS [Bounds]
-> ReadPrec Bounds
-> ReadPrec [Bounds]
-> Read 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
(Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool) -> Eq Bounds
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
Eq Bounds
-> (Bounds -> Bounds -> Ordering)
-> (Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bool)
-> (Bounds -> Bounds -> Bounds)
-> (Bounds -> Bounds -> Bounds)
-> Ord 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
$cp1Ord :: Eq Bounds
Ord)

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

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 81 "src/Monomer/Graphics/FFI.chs" #-}

  alignment _ = 8
{-# LINE 82 "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 {Ptr GlyphPosition -> Int -> Ptr CChar -> IO ()
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 {Ptr GlyphPosition -> Int -> CFloat -> IO ()
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 {Ptr GlyphPosition -> Int -> CFloat -> IO ()
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 {Ptr GlyphPosition -> Int -> CFloat -> IO ()
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 {Ptr GlyphPosition -> Int -> CFloat -> IO ()
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 {Ptr GlyphPosition -> Int -> CFloat -> IO ()
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 99 "src/Monomer/Graphics/FFI.chs" #-}


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

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

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

withText :: Text -> (CString -> IO b) -> IO b
withText :: Text -> (Ptr CChar -> IO b) -> IO b
withText Text
t = ByteString -> (Ptr CChar -> IO b) -> IO b
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 :: (Ptr a -> b) -> b
withNull Ptr a -> b
f = Ptr a -> b
f Ptr a
forall a. Ptr a
nullPtr

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

deriving instance Storable FMContext

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

{-# LINE 121 "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 123 "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 125 "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 127 "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 129 "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 131 "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 133 "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 135 "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 143 "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 151 "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 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))))))))