-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

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

module GI.Rsvg.Callbacks
    ( 

 -- * Signals


-- ** SizeFunc #signal:SizeFunc#

    C_SizeFunc                              ,
    SizeFunc                                ,
    SizeFunc_WithClosures                   ,
    drop_closures_SizeFunc                  ,
    dynamic_SizeFunc                        ,
    genClosure_SizeFunc                     ,
    mk_SizeFunc                             ,
    noSizeFunc                              ,
    noSizeFunc_WithClosures                 ,
    wrap_SizeFunc                           ,




    ) 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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
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 GHC.Records as R


-- callback SizeFunc
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "width"
          , argType = TBasicType TInt
          , direction = DirectionOut
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the width of the SVG"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferEverything
          }
      , Arg
          { argCName = "height"
          , argType = TBasicType TInt
          , direction = DirectionOut
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the height of the SVG"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferEverything
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "user data" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = 2
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated =
      Just
        DeprecationInfo
          { deprecatedSinceVersion = Just "2.14."
          , deprecationMessage =
              Just
                "Use [method@Rsvg.Handle.render_document] instead, which lets you specify\na viewport size in which to render the SVG document."
          }
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Function to let a user of the library specify the SVG's dimensions\n\nSee the documentation for [method@Rsvg.Handle.set_size_callback] for an example, and\nfor the reasons for deprecation."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_SizeFunc =
    Ptr Int32 ->
    Ptr Int32 ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the width of the SVG"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the height of the SVG"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_SizeFunc :: FunPtr C_SizeFunc -> C_SizeFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_SizeFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_SizeFunc
    -> Ptr ()
    -- ^ /@userData@/: user data
    -> m ((Int32, Int32))
dynamic_SizeFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_SizeFunc -> Ptr () -> m (Int32, Int32)
dynamic_SizeFunc FunPtr C_SizeFunc
__funPtr Ptr ()
userData = IO (Int32, Int32) -> m (Int32, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32) -> m (Int32, Int32))
-> IO (Int32, Int32) -> m (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Int32
width <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
height <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    (FunPtr C_SizeFunc -> C_SizeFunc
__dynamic_C_SizeFunc FunPtr C_SizeFunc
__funPtr) Ptr Int32
width Ptr Int32
height Ptr ()
userData
    Int32
width' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
width
    Int32
height' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
height
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
width
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
height
    (Int32, Int32) -> IO (Int32, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
width', Int32
height')

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

{-# DEPRECATED SizeFunc ["(Since version 2.14.)","Use 'GI.Rsvg.Objects.Handle.handleRenderDocument' instead, which lets you specify","a viewport size in which to render the SVG document."] #-}
-- | Function to let a user of the library specify the SVG\'s dimensions
-- 
-- See the documentation for 'GI.Rsvg.Objects.Handle.handleSetSizeCallback' for an example, and
-- for the reasons for deprecation.
type SizeFunc =
    IO ((Int32, Int32))

-- | A convenience synonym for @`Nothing` :: `Maybe` `SizeFunc`@.
noSizeFunc :: Maybe SizeFunc
noSizeFunc :: Maybe (IO (Int32, Int32))
noSizeFunc = Maybe (IO (Int32, Int32))
forall a. Maybe a
Nothing

-- | Function to let a user of the library specify the SVG\'s dimensions
-- 
-- See the documentation for 'GI.Rsvg.Objects.Handle.handleSetSizeCallback' for an example, and
-- for the reasons for deprecation.
type SizeFunc_WithClosures =
    Ptr ()
    -- ^ /@userData@/: user data
    -> IO ((Int32, Int32))

-- | A convenience synonym for @`Nothing` :: `Maybe` `SizeFunc_WithClosures`@.
noSizeFunc_WithClosures :: Maybe SizeFunc_WithClosures
noSizeFunc_WithClosures :: Maybe SizeFunc_WithClosures
noSizeFunc_WithClosures = Maybe SizeFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_SizeFunc :: SizeFunc -> SizeFunc_WithClosures
drop_closures_SizeFunc :: IO (Int32, Int32) -> SizeFunc_WithClosures
drop_closures_SizeFunc IO (Int32, Int32)
_f Ptr ()
_ = IO (Int32, Int32)
_f 

-- | Wrap the callback into a `GClosure`.
genClosure_SizeFunc :: MonadIO m => SizeFunc -> m (GClosure C_SizeFunc)
genClosure_SizeFunc :: forall (m :: * -> *).
MonadIO m =>
IO (Int32, Int32) -> m (GClosure C_SizeFunc)
genClosure_SizeFunc IO (Int32, Int32)
cb = IO (GClosure C_SizeFunc) -> m (GClosure C_SizeFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_SizeFunc) -> m (GClosure C_SizeFunc))
-> IO (GClosure C_SizeFunc) -> m (GClosure C_SizeFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: SizeFunc_WithClosures
cb' = IO (Int32, Int32) -> SizeFunc_WithClosures
drop_closures_SizeFunc IO (Int32, Int32)
cb
    let cb'' :: C_SizeFunc
cb'' = Maybe (Ptr (FunPtr C_SizeFunc))
-> SizeFunc_WithClosures -> C_SizeFunc
wrap_SizeFunc Maybe (Ptr (FunPtr C_SizeFunc))
forall a. Maybe a
Nothing SizeFunc_WithClosures
cb'
    C_SizeFunc -> IO (FunPtr C_SizeFunc)
mk_SizeFunc C_SizeFunc
cb'' IO (FunPtr C_SizeFunc)
-> (FunPtr C_SizeFunc -> IO (GClosure C_SizeFunc))
-> IO (GClosure C_SizeFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_SizeFunc -> IO (GClosure C_SizeFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `SizeFunc` into a `C_SizeFunc`.
wrap_SizeFunc :: 
    Maybe (Ptr (FunPtr C_SizeFunc)) ->
    SizeFunc_WithClosures ->
    C_SizeFunc
wrap_SizeFunc :: Maybe (Ptr (FunPtr C_SizeFunc))
-> SizeFunc_WithClosures -> C_SizeFunc
wrap_SizeFunc Maybe (Ptr (FunPtr C_SizeFunc))
gi'funptrptr SizeFunc_WithClosures
gi'cb Ptr Int32
width Ptr Int32
height Ptr ()
userData = do
    (Int32
outwidth, Int32
outheight) <- SizeFunc_WithClosures
gi'cb  Ptr ()
userData
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int32
width Int32
outwidth
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int32
height Int32
outheight
    Maybe (Ptr (FunPtr C_SizeFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_SizeFunc))
gi'funptrptr