{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc)
-}

#define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \
       && !defined(__HADDOCK_VERSION__))

module GI.PangoCairo.Callbacks
    (

 -- * Signals
-- ** ShapeRendererFunc #signal:ShapeRendererFunc#

    C_ShapeRendererFunc                     ,
    ShapeRendererFunc                       ,
    dynamic_ShapeRendererFunc               ,
    genClosure_ShapeRendererFunc            ,
    mk_ShapeRendererFunc                    ,
    noShapeRendererFunc                     ,
    wrap_ShapeRendererFunc                  ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Pango.Structs.AttrShape as Pango.AttrShape

-- callback ShapeRendererFunc
--          -> Callable {returnType = Nothing, returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, args = [Arg {argCName = "cr", argType = TInterface (Name {namespace = "cairo", name = "Context"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a Cairo context with current point set to where the shape should\nbe rendered", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "attr", argType = TInterface (Name {namespace = "Pango", name = "AttrShape"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the %PANGO_ATTR_SHAPE to render", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "do_path", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "whether only the shape path should be appended to current\npath of @cr and no filling/stroking done.  This will be set\nto %TRUE when called from pango_cairo_layout_path() and\npango_cairo_layout_line_path() rendering functions.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "user data passed to pango_cairo_context_set_shape_renderer()", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Just "Function type for rendering attributes of type %PANGO_ATTR_SHAPE\nwith Pango's Cairo renderer.", sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_ShapeRendererFunc =
    Ptr Cairo.Context.Context ->
    Ptr Pango.AttrShape.AttrShape ->
    CInt ->
    Ptr () ->
    IO ()

-- Args : [Arg {argCName = "cr", argType = TInterface (Name {namespace = "cairo", name = "Context"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a Cairo context with current point set to where the shape should\nbe rendered", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "attr", argType = TInterface (Name {namespace = "Pango", name = "AttrShape"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the %PANGO_ATTR_SHAPE to render", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "do_path", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "whether only the shape path should be appended to current\npath of @cr and no filling/stroking done.  This will be set\nto %TRUE when called from pango_cairo_layout_path() and\npango_cairo_layout_line_path() rendering functions.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "user data passed to pango_cairo_context_set_shape_renderer()", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ShapeRendererFunc :: FunPtr C_ShapeRendererFunc -> C_ShapeRendererFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ShapeRendererFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_ShapeRendererFunc
    -> Cairo.Context.Context
    {- ^ /@cr@/: a Cairo context with current point set to where the shape should
be rendered -}
    -> Pango.AttrShape.AttrShape
    {- ^ /@attr@/: the 'GI.Pango.Enums.AttrTypeShape' to render -}
    -> Bool
    {- ^ /@doPath@/: whether only the shape path should be appended to current
path of /@cr@/ and no filling\/stroking done.  This will be set
to 'True' when called from 'GI.PangoCairo.Functions.layoutPath' and
'GI.PangoCairo.Functions.layoutLinePath' rendering functions. -}
    -> Ptr ()
    {- ^ /@data@/: user data passed to 'GI.PangoCairo.Functions.contextSetShapeRenderer' -}
    -> m ()
dynamic_ShapeRendererFunc __funPtr cr attr doPath data_ = liftIO $ do
    cr' <- unsafeManagedPtrGetPtr cr
    attr' <- unsafeManagedPtrGetPtr attr
    let doPath' = (fromIntegral . fromEnum) doPath
    (__dynamic_C_ShapeRendererFunc __funPtr) cr' attr' doPath' data_
    touchManagedPtr cr
    touchManagedPtr attr
    return ()

-- | Generate a function pointer callable from C code, from a `C_ShapeRendererFunc`.
foreign import ccall "wrapper"
    mk_ShapeRendererFunc :: C_ShapeRendererFunc -> IO (FunPtr C_ShapeRendererFunc)

{- |
Function type for rendering attributes of type 'GI.Pango.Enums.AttrTypeShape'
with Pango\'s Cairo renderer.
-}
type ShapeRendererFunc =
    Cairo.Context.Context
    {- ^ /@cr@/: a Cairo context with current point set to where the shape should
be rendered -}
    -> Pango.AttrShape.AttrShape
    {- ^ /@attr@/: the 'GI.Pango.Enums.AttrTypeShape' to render -}
    -> Bool
    {- ^ /@doPath@/: whether only the shape path should be appended to current
path of /@cr@/ and no filling\/stroking done.  This will be set
to 'True' when called from 'GI.PangoCairo.Functions.layoutPath' and
'GI.PangoCairo.Functions.layoutLinePath' rendering functions. -}
    -> Ptr ()
    {- ^ /@data@/: user data passed to 'GI.PangoCairo.Functions.contextSetShapeRenderer' -}
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ShapeRendererFunc`@.
noShapeRendererFunc :: Maybe ShapeRendererFunc
noShapeRendererFunc = Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_ShapeRendererFunc :: MonadIO m => ShapeRendererFunc -> m (GClosure C_ShapeRendererFunc)
genClosure_ShapeRendererFunc cb = liftIO $ do
    let cb' = wrap_ShapeRendererFunc Nothing cb
    mk_ShapeRendererFunc cb' >>= B.GClosure.newGClosure


-- | Wrap a `ShapeRendererFunc` into a `C_ShapeRendererFunc`.
wrap_ShapeRendererFunc ::
    Maybe (Ptr (FunPtr C_ShapeRendererFunc)) ->
    ShapeRendererFunc ->
    C_ShapeRendererFunc
wrap_ShapeRendererFunc funptrptr _cb cr attr doPath data_ = do
    B.ManagedPtr.withTransient Cairo.Context.Context cr $ \cr' -> do
        attr' <- (newPtr Pango.AttrShape.AttrShape) attr
        let doPath' = (/= 0) doPath
        _cb  cr' attr' doPath' data_
        maybeReleaseFunPtr funptrptr