{-# LANGUAGE CPP #-}
module NanoVG
  ( FileName(..)
  , Context(..)
  , Extent(..)
  , Solidity(..)
  , LineCap(..)
  , beginFrame
  , cancelFrame
  , endFrame
  -- * Color utils
  , Color(..)
  , rgb
  , rgbf
  , rgba
  , rgbaf
  , lerpRGBA
  , transRGBA
  , transRGBAf
  , hsl
  , hsla
  -- * State handling
  , save
  , restore
  , reset
  -- * Render styles
  , strokeColor
  , strokePaint
  , fillColor
  , fillPaint
  , miterLimit
  , strokeWidth
  , lineCap
  , lineJoin
  , globalAlpha
  -- * Transforms
  , Transformation(..)
  , resetTransform
  , transform
  , translate
  , rotate
  , skewX
  , skewY
  , scale
  , currentTransform
  , transformIdentity
  , transformTranslate
  , transformScale
  , transformRotate
  , transformSkewX
  , transformSkewY
  , transformMultiply
  , transformPremultiply
  , transformInverse
  , transformPoint
  , degToRad
  , radToDeg
  -- * Images
  , Image(..)
  , createImage
  , createImageMem
  , createImageRGBA
  , updateImage
  , imageSize
  , deleteImage
  -- * Paints
  , Paint(..)
  , linearGradient
  , boxGradient
  , radialGradient
  , imagePattern
  -- * Scissoring
  , scissor
  , intersectScissor
  , resetScissor
  -- * Paths
  , beginPath
  , moveTo
  , lineTo
  , bezierTo
  , quadTo
  , arcTo
  , closePath
  , Winding(..)
  , pathWinding
  , arc
  , rect
  , roundedRect
  , roundedRectVarying
  , ellipse
  , circle
  , fill
  , stroke
  -- * Global Composite
  , BlendFactor(..)
  , CompositeOperation(..)
  , globalCompositeOperation
  , globalCompositeBlendFunc
  , globalCompositeBlendFuncSeparate
  -- * Text
  , Font(..)
  , createFont
  , createFontAtIndex
  , createFontMem
  , createFontMemAtIndex
  , findFont
  , addFallbackFontId
  , addFallbackFont
  , resetFallbackFontsId
  , resetFallbackFonts
  , fontSize
  , fontBlur
  , textLetterSpacing
  , textLineHeight
  , Align(..)
  , textAlign
  , fontFaceId
  , fontFace
  , text
  , textBox
  , Bounds(..)
  , textBounds
  , textBoxBounds
  , GlyphPosition(..)
  , GlyphPositionPtr
  , textGlyphPositions
  , textMetrics
  , TextRow(..)
  , TextRowPtr
  , textBreakLines
  -- * GL
  , CreateFlags(..)
#if defined(GLES_3)
  , createGLES3
  , deleteGLES3
  , createImageFromHandleGLES3
  , imageHandleGLES3
#elif defined(GL_2)
  , createGL2
  , deleteGL2
  , createImageFromHandleGL2
  , imageHandleGL2
#else
  , createGL3
  , deleteGL3
  , createImageFromHandleGL3
  , imageHandleGL3
#endif
  -- * Vector types
  , V2(..)
  , V3(..)
  , V4(..)
  , M23
  ) where

import           Data.Functor ((<$>))
import           Control.Monad
import qualified Data.Text as T
import           Data.Text.Foreign
import qualified Data.Vector as V
import           Foreign.C.Types
import           Foreign.Marshal.Alloc
import           Foreign.Ptr
import           Foreign.Storable
import           NanoVG.Internal
import           NanoVG.Internal.CreateContext
#if defined(GLES_3)
import           NanoVG.Internal.GLES3
#elif defined(GL_2)
import           NanoVG.Internal.GL2
#else
import           NanoVG.Internal.GL3
#endif
import qualified NanoVG.Internal.Text as Internal
import           NanoVG.Internal.Text hiding (textBreakLines,textGlyphPositions,text)

-- | High level wrapper around NanoVG.Internal.textBreakLines
-- This uses the fonts for width calculations so make sure you have them setup properly
textBreakLines :: Context -> T.Text -> CFloat -> CInt -> (TextRow -> CInt -> IO ()) -> IO ()
textBreakLines :: Context
-> Text -> CFloat -> CInt -> (TextRow -> CInt -> IO ()) -> IO ()
textBreakLines Context
c Text
text' CFloat
width' CInt
chunkSize TextRow -> CInt -> IO ()
f =
  Text -> (CStringLen -> IO ()) -> IO ()
forall a. Text -> (CStringLen -> IO a) -> IO a
withCStringLen Text
text' ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
  \(Ptr CChar
startPtr,Int
len) ->
    Int -> Int -> (Ptr TextRow -> IO ()) -> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned (TextRow -> Int
forall a. Storable a => a -> Int
sizeOf (TextRow
forall a. HasCallStack => a
undefined :: TextRow) Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
chunkSize)
                       (TextRow -> Int
forall a. Storable a => a -> Int
alignment (TextRow
forall a. HasCallStack => a
undefined :: TextRow)) ((Ptr TextRow -> IO ()) -> IO ())
-> (Ptr TextRow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    \Ptr TextRow
arrayPtr ->
      do let endPtr :: Ptr b
endPtr = Ptr CChar
startPtr Ptr CChar -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
             loop :: CInt -> Ptr CChar -> IO ()
loop CInt
line Ptr CChar
ptr =
               do CInt
count <-
                    Context
-> Ptr CChar
-> Ptr CChar
-> CFloat
-> Ptr TextRow
-> CInt
-> IO CInt
Internal.textBreakLines Context
c Ptr CChar
ptr Ptr CChar
forall b. Ptr b
endPtr CFloat
width' Ptr TextRow
arrayPtr CInt
chunkSize
                  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
count CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    CInt -> Ptr CChar -> IO ()
loop (CInt
line CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
count) (Ptr CChar -> IO ()) -> IO (Ptr CChar) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CInt -> Ptr TextRow -> CInt -> IO (Ptr CChar)
readChunk CInt
line Ptr TextRow
arrayPtr CInt
count
         CInt -> Ptr CChar -> IO ()
loop CInt
0 Ptr CChar
startPtr
  where readChunk
          :: CInt -> TextRowPtr -> CInt -> IO (Ptr CChar)
        readChunk :: CInt -> Ptr TextRow -> CInt -> IO (Ptr CChar)
readChunk CInt
baseline Ptr TextRow
arrayPtr CInt
count =
          do [CInt] -> (CInt -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CInt
0 .. (CInt
count CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1)] ((CInt -> IO ()) -> IO ()) -> (CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
               \CInt
i ->
                 do TextRow
textRow <-
                      Ptr TextRow -> Int -> IO TextRow
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr TextRow
arrayPtr
                                  (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i)
                    TextRow -> CInt -> IO ()
f TextRow
textRow (CInt
baseline CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
i)
             TextRow -> Ptr CChar
next (TextRow -> Ptr CChar) -> IO TextRow -> IO (Ptr CChar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               Ptr TextRow -> Int -> IO TextRow
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr TextRow
arrayPtr
                           (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt
count CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1))

-- | High level wrapper around NanoVG.Internal.textGlyphPositions
-- Might be changed to return a vector in the future
textGlyphPositions :: Context -> CFloat -> CFloat -> Ptr CChar -> Ptr CChar -> CInt -> IO (V.Vector GlyphPosition)
textGlyphPositions :: Context
-> CFloat
-> CFloat
-> Ptr CChar
-> Ptr CChar
-> CInt
-> IO (Vector GlyphPosition)
textGlyphPositions Context
c CFloat
x CFloat
y Ptr CChar
startPtr Ptr CChar
endPtr CInt
maxGlyphs =
  Int
-> Int
-> (Ptr GlyphPosition -> IO (Vector GlyphPosition))
-> IO (Vector GlyphPosition)
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned
    (GlyphPosition -> Int
forall a. Storable a => a -> Int
sizeOf (GlyphPosition
forall a. HasCallStack => a
undefined :: GlyphPosition) Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
maxGlyphs)
    (GlyphPosition -> Int
forall a. Storable a => a -> Int
alignment (GlyphPosition
forall a. HasCallStack => a
undefined :: GlyphPosition)) ((Ptr GlyphPosition -> IO (Vector GlyphPosition))
 -> IO (Vector GlyphPosition))
-> (Ptr GlyphPosition -> IO (Vector GlyphPosition))
-> IO (Vector GlyphPosition)
forall a b. (a -> b) -> a -> b
$
  \Ptr GlyphPosition
arrayPtr ->
    do CInt
count <-
         Context
-> CFloat
-> CFloat
-> Ptr CChar
-> Ptr CChar
-> Ptr GlyphPosition
-> CInt
-> IO CInt
Internal.textGlyphPositions Context
c CFloat
x CFloat
y Ptr CChar
startPtr Ptr CChar
endPtr Ptr GlyphPosition
arrayPtr CInt
maxGlyphs
       Ptr GlyphPosition -> CInt -> IO (Vector GlyphPosition)
readChunk Ptr GlyphPosition
arrayPtr CInt
count
  where readChunk
          :: GlyphPositionPtr -> CInt -> IO (V.Vector GlyphPosition)
        readChunk :: Ptr GlyphPosition -> CInt -> IO (Vector GlyphPosition)
readChunk Ptr GlyphPosition
arrayPtr CInt
count =
          Int -> (Int -> IO GlyphPosition) -> IO (Vector GlyphPosition)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
count) ((Int -> IO GlyphPosition) -> IO (Vector GlyphPosition))
-> (Int -> IO GlyphPosition) -> IO (Vector GlyphPosition)
forall a b. (a -> b) -> a -> b
$
          \Int
i ->
            Ptr GlyphPosition -> Int -> IO GlyphPosition
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr GlyphPosition
arrayPtr
                        (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

text :: Context -> CFloat -> CFloat -> T.Text -> IO ()
text :: Context -> CFloat -> CFloat -> Text -> IO ()
text Context
c CFloat
x CFloat
y Text
t = Text -> (CStringLen -> IO ()) -> IO ()
forall a. Text -> (CStringLen -> IO a) -> IO a
withCStringLen Text
t ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr,Int
len) -> Context -> CFloat -> CFloat -> Ptr CChar -> Ptr CChar -> IO ()
Internal.text Context
c CFloat
x CFloat
y Ptr CChar
ptr (Ptr CChar
ptr Ptr CChar -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len)