-- GENERATED by C->Haskell Compiler, version 0.28.1 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/NanoVG/Internal/Text.chs" #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module NanoVG.Internal.Text where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import           Control.Applicative (pure)
import           Data.ByteString hiding (null)
import qualified Data.Set as S
import qualified Data.Text as T
import           Foreign.C.Types
import           Foreign.Marshal.Alloc
import           Foreign.Ptr
import           Foreign.Storable
import           NanoVG.Internal.Context
import           NanoVG.Internal.FFIHelpers
import           NanoVG.Internal.FixedVector
import           NanoVG.Internal.Types
import           Prelude hiding (null)




{-# LINE 21 "src/NanoVG/Internal/Text.chs" #-}


data Align = AlignLeft
           | AlignCenter
           | AlignRight
           | AlignTop
           | AlignMiddle
           | AlignBottom
           | AlignBaseline
  deriving (Show,Read,Eq,Ord)
instance Enum Align where
  succ AlignLeft = AlignCenter
  succ AlignCenter = AlignRight
  succ AlignRight = AlignTop
  succ AlignTop = AlignMiddle
  succ AlignMiddle = AlignBottom
  succ AlignBottom = AlignBaseline
  succ AlignBaseline = error "Align.succ: AlignBaseline has no successor"

  pred AlignCenter = AlignLeft
  pred AlignRight = AlignCenter
  pred AlignTop = AlignRight
  pred AlignMiddle = AlignTop
  pred AlignBottom = AlignMiddle
  pred AlignBaseline = AlignBottom
  pred AlignLeft = error "Align.pred: AlignLeft has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from AlignBaseline

  fromEnum AlignLeft = 1
  fromEnum AlignCenter = 2
  fromEnum AlignRight = 4
  fromEnum AlignTop = 8
  fromEnum AlignMiddle = 16
  fromEnum AlignBottom = 32
  fromEnum AlignBaseline = 64

  toEnum 1 = AlignLeft
  toEnum 2 = AlignCenter
  toEnum 4 = AlignRight
  toEnum 8 = AlignTop
  toEnum 16 = AlignMiddle
  toEnum 32 = AlignBottom
  toEnum 64 = AlignBaseline
  toEnum unmatched = error ("Align.toEnum: Cannot match " ++ show unmatched)

{-# LINE 25 "src/NanoVG/Internal/Text.chs" #-}


-- | Newtype to avoid accidental use of ints
newtype Font = Font {fontHandle :: CInt} deriving (Show,Read,Eq,Ord)

data TextRow =
  TextRow { -- | Pointer to the input text where the row starts.
            start :: !(Ptr CChar)
            -- | Pointer to the input text where the row ends (one past the last character).
          , end :: !(Ptr CChar)
            -- | Pointer to the beginning of the next row.
          , next :: !(Ptr CChar)
            -- | Logical width of the row.
          , width :: !CFloat
            -- | Actual bounds of the row. Logical with and bounds can differ because of kerning and some parts over extending.
          , textRowMinX :: !CFloat
          , textRowMaxX :: !CFloat}
  deriving (Show,Eq,Ord)

instance Storable TextRow where
  sizeOf _ = 40
  alignment _ = 8
{-# LINE 46 "src/NanoVG/Internal/Text.chs" #-}

  peek p =
    do start <- (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) p
       end <- (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) p
       next <- (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) p
       width <- (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO C2HSImp.CFloat}) p
       minX <- (\ptr -> do {C2HSImp.peekByteOff ptr 28 :: IO C2HSImp.CFloat}) p
       maxX <- (\ptr -> do {C2HSImp.peekByteOff ptr 32 :: IO C2HSImp.CFloat}) p
       pure (TextRow start end next width minX maxX)
  poke p (TextRow {..}) =
    do (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: (C2HSImp.Ptr C2HSImp.CChar))}) p start
       (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: (C2HSImp.Ptr C2HSImp.CChar))}) p end
       (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: (C2HSImp.Ptr C2HSImp.CChar))}) p next
       (\ptr val -> do {C2HSImp.pokeByteOff ptr 24 (val :: C2HSImp.CFloat)}) p width
       (\ptr val -> do {C2HSImp.pokeByteOff ptr 28 (val :: C2HSImp.CFloat)}) p textRowMinX
       (\ptr val -> do {C2HSImp.pokeByteOff ptr 32 (val :: C2HSImp.CFloat)}) p textRowMaxX

type TextRowPtr = C2HSImp.Ptr (TextRow)
{-# LINE 63 "src/NanoVG/Internal/Text.chs" #-}


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

instance Storable GlyphPosition where
  sizeOf _ = 24
  alignment _ = 8
{-# LINE 77 "src/NanoVG/Internal/Text.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
       pure (GlyphPosition str x minx maxx)
  poke p (GlyphPosition str x minx maxx) =
    do (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: (C2HSImp.Ptr C2HSImp.CChar))}) p str
       (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CFloat)}) p x
       (\ptr val -> do {C2HSImp.pokeByteOff ptr 12 (val :: C2HSImp.CFloat)}) p minx
       (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: C2HSImp.CFloat)}) p maxx

type GlyphPositionPtr = C2HSImp.Ptr (GlyphPosition)
{-# LINE 90 "src/NanoVG/Internal/Text.chs" #-}


safeFont :: CInt -> Maybe Font
safeFont i
  | i < 0 = Nothing
  | otherwise = Just (Font i)

-- | Creates font by loading it from the disk from specified file name.
-- Returns handle to the font.
createFont :: (Context) -> (T.Text) -> (FileName) -> IO ((Maybe Font))
createFont a1 a2 a3 =
  let {a1' = id a1} in 
  withCString a2 $ \a2' -> 
  (withCString.unwrapFileName) a3 $ \a3' -> 
  createFont'_ a1' a2' a3' >>= \res ->
  let {res' = safeFont res} in
  return (res')

{-# LINE 100 "src/NanoVG/Internal/Text.chs" #-}


-- | Creates image by loading it from the specified memory chunk.
-- Returns handle to the font.
createFontMem :: (Context) -> (T.Text) -> (ByteString) -> IO ((Maybe Font))
createFontMem a1 a2 a3 =
  let {a1' = id a1} in 
  withCString a2 $ \a2' -> 
  useAsCStringLen' a3 $ \(a3'1, a3'2) -> 
  zero $ \a4' -> 
  createFontMem'_ a1' a2' a3'1  a3'2 a4' >>= \res ->
  let {res' = safeFont res} in
  return (res')

{-# LINE 105 "src/NanoVG/Internal/Text.chs" #-}


-- | Finds a loaded font of specified name, and returns handle to it, or -1 if the font is not found.
findFont :: (Context) -> (T.Text) -> IO ((Maybe Font))
findFont a1 a2 =
  let {a1' = id a1} in 
  withCString a2 $ \a2' -> 
  findFont'_ a1' a2' >>= \res ->
  let {res' = safeFont res} in
  return (res')

{-# LINE 109 "src/NanoVG/Internal/Text.chs" #-}


-- | Sets the font size of current text style.
fontSize :: (Context) -> (CFloat) -> IO ()
fontSize a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  fontSize'_ a1' a2' >>
  return ()

{-# LINE 113 "src/NanoVG/Internal/Text.chs" #-}


-- | Sets the blur of current text style.
fontBlur :: (Context) -> (CFloat) -> IO ()
fontBlur a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  fontBlur'_ a1' a2' >>
  return ()

{-# LINE 117 "src/NanoVG/Internal/Text.chs" #-}


-- | Sets the letter spacing of current text style.
textLetterSpacing :: (Context) -> (CFloat) -> IO ()
textLetterSpacing a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  textLetterSpacing'_ a1' a2' >>
  return ()

{-# LINE 121 "src/NanoVG/Internal/Text.chs" #-}


-- | Sets the proportional line height of current text style. The line height is specified as multiple of font size. 
textLineHeight :: (Context) -> (CFloat) -> IO ()
textLineHeight a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  textLineHeight'_ a1' a2' >>
  return ()

{-# LINE 125 "src/NanoVG/Internal/Text.chs" #-}


-- | Sets the text align of current text style, see NVGalign for options.
textAlign :: (Context) -> (S.Set Align) -> IO ()
textAlign a1 a2 =
  let {a1' = id a1} in 
  let {a2' = bitMask a2} in 
  textAlign'_ a1' a2' >>
  return ()

{-# LINE 129 "src/NanoVG/Internal/Text.chs" #-}


-- | Sets the font face based on specified id of current text style.
fontFaceId :: (Context) -> (Font) -> IO ()
fontFaceId a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fontHandle a2} in 
  fontFaceId'_ a1' a2' >>
  return ()

{-# LINE 133 "src/NanoVG/Internal/Text.chs" #-}


-- | Sets the font face based on specified name of current text styl
fontFace :: (Context) -> (T.Text) -> IO ()
fontFace a1 a2 =
  let {a1' = id a1} in 
  withCString a2 $ \a2' -> 
  fontFace'_ a1' a2' >>
  return ()

{-# LINE 137 "src/NanoVG/Internal/Text.chs" #-}


-- | Draws text string at specified location. If end is specified only the sub-string up to the end is drawn.
text :: (Context) -> (CFloat) -> (CFloat) -> (Ptr CChar) -> (Ptr CChar) -> IO ()
text a1 a2 a3 a4 a5 =
  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 
  text'_ a1' a2' a3' a4' a5' >>
  return ()

{-# LINE 141 "src/NanoVG/Internal/Text.chs" #-}


-- | Draws multi-line text string at specified location wrapped at the specified width. If end is specified only the sub-string up to the end is drawn.
-- | White space is stripped at the beginning of the rows, the text is split at word boundaries or when new-line characters are encountered.
-- | Words longer than the max width are slit at nearest character (i.e. no hyphenation).
textBox :: (Context) -> (CFloat) -> (CFloat) -> (CFloat) -> (T.Text) -> IO ()
textBox a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  withCString a5 $ \a5' -> 
  null $ \a6' -> 
  textBox'_ a1' a2' a3' a4' a5' a6' >>
  return ()

{-# LINE 147 "src/NanoVG/Internal/Text.chs" #-}


newtype Bounds = Bounds (V4 CFloat) deriving (Show,Read,Eq,Ord)

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

peekBounds :: Ptr CFloat -> IO Bounds
peekBounds = peek . castPtr

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

-- | Measures the specified text string. Parameter bounds should be a pointer to float[4],
-- if the bounding box of the text should be returned. The bounds value are [xmin,ymin, xmax,ymax]
-- Returns the horizontal advance of the measured text (i.e. where the next character should drawn).
-- Measured values are returned in local coordinate space.
textBounds :: (Context) -> (CFloat) -> (CFloat) -> (T.Text) -> IO ((Bounds))
textBounds a1 a2 a3 a4 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  withCString a4 $ \a4' -> 
  null $ \a5' -> 
  allocaBounds $ \a6' -> 
  textBounds'_ a1' a2' a3' a4' a5' a6' >>
  peekBounds  a6'>>= \a6'' -> 
  return (a6'')

{-# LINE 179 "src/NanoVG/Internal/Text.chs" #-}


-- | Measures the specified multi-text string. Parameter bounds should be a pointer to float[4],
-- if the bounding box of the text should be returned. The bounds value are [xmin,ymin, xmax,ymax]
-- Measured values are returned in local coordinate space.
textBoxBounds :: (Context) -> (CFloat) -> (CFloat) -> (CFloat) -> (T.Text) -> IO ((Bounds))
textBoxBounds a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  withCString a5 $ \a5' -> 
  null $ \a6' -> 
  allocaBounds $ \a7' -> 
  textBoxBounds'_ a1' a2' a3' a4' a5' a6' a7' >>
  peekBounds  a7'>>= \a7'' -> 
  return (a7'')

{-# LINE 185 "src/NanoVG/Internal/Text.chs" #-}


-- | Calculates the glyph x positions of the specified text. If end is specified only the sub-string will be used.
-- Measured values are returned in local coordinate space.
textGlyphPositions :: (Context) -> (CFloat) -> (CFloat) -> (Ptr CChar) -> (Ptr CChar) -> (GlyphPositionPtr) -> (CInt) -> IO ((CInt))
textGlyphPositions 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 
  textGlyphPositions'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 190 "src/NanoVG/Internal/Text.chs" #-}


-- | Returns the vertical metrics based on the current text style.
-- Measured values are returned in local coordinate space.
textMetrics :: (Context) -> IO ((CFloat), (CFloat), (CFloat))
textMetrics a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  textMetrics'_ a1' a2' a3' a4' >>
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  peek  a4'>>= \a4'' -> 
  return (a2'', a3'', a4'')

{-# LINE 195 "src/NanoVG/Internal/Text.chs" #-}


-- | Breaks the specified text into lines. If end is specified only the sub-string will be used.
-- White space is stripped at the beginning of the rows, the text is split at word boundaries or when new-line characters are encountered.
-- Words longer than the max width are slit at nearest character (i.e. no hyphenation).
textBreakLines :: (Context) -> (Ptr CChar) -> (Ptr CChar) -> (CFloat) -> (TextRowPtr) -> (CInt) -> IO ((CInt))
textBreakLines a1 a2 a3 a4 a5 a6 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = id a5} in 
  let {a6' = fromIntegral a6} in 
  textBreakLines'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 201 "src/NanoVG/Internal/Text.chs" #-}


foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgCreateFont"
  createFont'_ :: ((Context) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgCreateFontMem"
  createFontMem'_ :: ((Context) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgFindFont"
  findFont'_ :: ((Context) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgFontSize"
  fontSize'_ :: ((Context) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgFontBlur"
  fontBlur'_ :: ((Context) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgTextLetterSpacing"
  textLetterSpacing'_ :: ((Context) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgTextLineHeight"
  textLineHeight'_ :: ((Context) -> (C2HSImp.CFloat -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgTextAlign"
  textAlign'_ :: ((Context) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgFontFaceId"
  fontFaceId'_ :: ((Context) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgFontFace"
  fontFace'_ :: ((Context) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgText"
  text'_ :: ((Context) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CFloat))))))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgTextBox"
  textBox'_ :: ((Context) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))))))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgTextBounds"
  textBounds'_ :: ((Context) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (IO C2HSImp.CFloat)))))))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgTextBoxBounds"
  textBoxBounds'_ :: ((Context) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (IO ()))))))))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgTextGlyphPositions"
  textGlyphPositions'_ :: ((Context) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((GlyphPositionPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgTextMetrics"
  textMetrics'_ :: ((Context) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> ((C2HSImp.Ptr C2HSImp.CFloat) -> (IO ())))))

foreign import ccall unsafe "NanoVG/Internal/Text.chs.h nvgTextBreakLines"
  textBreakLines'_ :: ((Context) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CFloat -> ((TextRowPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))))