{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A small part of a t'GI.Vips.Objects.Image.Image'. /@valid@/ holds the left\/top\/width\/height of the
-- area of pixels that are available from the region.
-- 
-- See also: @/VIPS_REGION_ADDR()/@, 'GI.Vips.Objects.Region.regionNew', 'GI.Vips.Objects.Region.regionRegionPrepare'.

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

module GI.Vips.Objects.Region
    ( 

-- * Exported types
    Region(..)                              ,
    IsRegion                                ,
    toRegion                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [argumentIsset]("GI.Vips.Objects.Object#g:method:argumentIsset"), [argumentNeedsstring]("GI.Vips.Objects.Object#g:method:argumentNeedsstring"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [build]("GI.Vips.Objects.Object#g:method:build"), [copy]("GI.Vips.Objects.Region#g:method:copy"), [equalsregion]("GI.Vips.Objects.Region#g:method:equalsregion"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [localCb]("GI.Vips.Objects.Object#g:method:localCb"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [preclose]("GI.Vips.Objects.Object#g:method:preclose"), [printDump]("GI.Vips.Objects.Object#g:method:printDump"), [printName]("GI.Vips.Objects.Object#g:method:printName"), [printSummary]("GI.Vips.Objects.Object#g:method:printSummary"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [regionBlack]("GI.Vips.Objects.Region#g:method:regionBlack"), [regionBuffer]("GI.Vips.Objects.Region#g:method:regionBuffer"), [regionFetch]("GI.Vips.Objects.Region#g:method:regionFetch"), [regionHeight]("GI.Vips.Objects.Region#g:method:regionHeight"), [regionImage]("GI.Vips.Objects.Region#g:method:regionImage"), [regionInvalidate]("GI.Vips.Objects.Region#g:method:regionInvalidate"), [regionPaint]("GI.Vips.Objects.Region#g:method:regionPaint"), [regionPaintPel]("GI.Vips.Objects.Region#g:method:regionPaintPel"), [regionPosition]("GI.Vips.Objects.Region#g:method:regionPosition"), [regionPrepare]("GI.Vips.Objects.Region#g:method:regionPrepare"), [regionPrepareTo]("GI.Vips.Objects.Region#g:method:regionPrepareTo"), [regionRegion]("GI.Vips.Objects.Region#g:method:regionRegion"), [regionWidth]("GI.Vips.Objects.Region#g:method:regionWidth"), [rewind]("GI.Vips.Objects.Object#g:method:rewind"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [sanity]("GI.Vips.Objects.Object#g:method:sanity"), [shrinkMethod]("GI.Vips.Objects.Region#g:method:shrinkMethod"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unrefOutputs]("GI.Vips.Objects.Object#g:method:unrefOutputs"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getArgumentFlags]("GI.Vips.Objects.Object#g:method:getArgumentFlags"), [getArgumentPriority]("GI.Vips.Objects.Object#g:method:getArgumentPriority"), [getArgumentToString]("GI.Vips.Objects.Object#g:method:getArgumentToString"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDescription]("GI.Vips.Objects.Object#g:method:getDescription"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setArgumentFromString]("GI.Vips.Objects.Object#g:method:setArgumentFromString"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFromString]("GI.Vips.Objects.Object#g:method:setFromString"), [setRequired]("GI.Vips.Objects.Object#g:method:setRequired"), [setStatic]("GI.Vips.Objects.Object#g:method:setStatic").

#if defined(ENABLE_OVERLOADING)
    ResolveRegionMethod                     ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    RegionCopyMethodInfo                    ,
#endif
    regionCopy                              ,


-- ** equalsregion #method:equalsregion#

#if defined(ENABLE_OVERLOADING)
    RegionEqualsregionMethodInfo            ,
#endif
    regionEqualsregion                      ,


-- ** new #method:new#

    regionNew                               ,


-- ** regionBlack #method:regionBlack#

#if defined(ENABLE_OVERLOADING)
    RegionRegionBlackMethodInfo             ,
#endif
    regionRegionBlack                       ,


-- ** regionBuffer #method:regionBuffer#

#if defined(ENABLE_OVERLOADING)
    RegionRegionBufferMethodInfo            ,
#endif
    regionRegionBuffer                      ,


-- ** regionFetch #method:regionFetch#

#if defined(ENABLE_OVERLOADING)
    RegionRegionFetchMethodInfo             ,
#endif
    regionRegionFetch                       ,


-- ** regionHeight #method:regionHeight#

#if defined(ENABLE_OVERLOADING)
    RegionRegionHeightMethodInfo            ,
#endif
    regionRegionHeight                      ,


-- ** regionImage #method:regionImage#

#if defined(ENABLE_OVERLOADING)
    RegionRegionImageMethodInfo             ,
#endif
    regionRegionImage                       ,


-- ** regionInvalidate #method:regionInvalidate#

#if defined(ENABLE_OVERLOADING)
    RegionRegionInvalidateMethodInfo        ,
#endif
    regionRegionInvalidate                  ,


-- ** regionPaint #method:regionPaint#

#if defined(ENABLE_OVERLOADING)
    RegionRegionPaintMethodInfo             ,
#endif
    regionRegionPaint                       ,


-- ** regionPaintPel #method:regionPaintPel#

#if defined(ENABLE_OVERLOADING)
    RegionRegionPaintPelMethodInfo          ,
#endif
    regionRegionPaintPel                    ,


-- ** regionPosition #method:regionPosition#

#if defined(ENABLE_OVERLOADING)
    RegionRegionPositionMethodInfo          ,
#endif
    regionRegionPosition                    ,


-- ** regionPrepare #method:regionPrepare#

#if defined(ENABLE_OVERLOADING)
    RegionRegionPrepareMethodInfo           ,
#endif
    regionRegionPrepare                     ,


-- ** regionPrepareTo #method:regionPrepareTo#

#if defined(ENABLE_OVERLOADING)
    RegionRegionPrepareToMethodInfo         ,
#endif
    regionRegionPrepareTo                   ,


-- ** regionRegion #method:regionRegion#

#if defined(ENABLE_OVERLOADING)
    RegionRegionRegionMethodInfo            ,
#endif
    regionRegionRegion                      ,


-- ** regionWidth #method:regionWidth#

#if defined(ENABLE_OVERLOADING)
    RegionRegionWidthMethodInfo             ,
#endif
    regionRegionWidth                       ,


-- ** shrinkMethod #method:shrinkMethod#

#if defined(ENABLE_OVERLOADING)
    RegionShrinkMethodMethodInfo            ,
#endif
    regionShrinkMethod                      ,




    ) 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.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.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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Vips.Enums as Vips.Enums
import {-# SOURCE #-} qualified GI.Vips.Objects.Image as Vips.Image
import {-# SOURCE #-} qualified GI.Vips.Objects.Object as Vips.Object
import {-# SOURCE #-} qualified GI.Vips.Structs.Rect as Vips.Rect

-- | Memory-managed wrapper type.
newtype Region = Region (SP.ManagedPtr Region)
    deriving (Region -> Region -> Bool
(Region -> Region -> Bool)
-> (Region -> Region -> Bool) -> Eq Region
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c== :: Region -> Region -> Bool
Eq)

instance SP.ManagedPtrNewtype Region where
    toManagedPtr :: Region -> ManagedPtr Region
toManagedPtr (Region ManagedPtr Region
p) = ManagedPtr Region
p

foreign import ccall "vips_region_get_type"
    c_vips_region_get_type :: IO B.Types.GType

instance B.Types.TypedObject Region where
    glibType :: IO GType
glibType = IO GType
c_vips_region_get_type

instance B.Types.GObject Region

-- | Type class for types which can be safely cast to `Region`, for instance with `toRegion`.
class (SP.GObject o, O.IsDescendantOf Region o) => IsRegion o
instance (SP.GObject o, O.IsDescendantOf Region o) => IsRegion o

instance O.HasParentTypes Region
type instance O.ParentTypes Region = '[Vips.Object.Object, GObject.Object.Object]

-- | Cast to `Region`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toRegion :: (MIO.MonadIO m, IsRegion o) => o -> m Region
toRegion :: forall (m :: * -> *) o. (MonadIO m, IsRegion o) => o -> m Region
toRegion = IO Region -> m Region
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Region -> m Region) -> (o -> IO Region) -> o -> m Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Region -> Region) -> o -> IO Region
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Region -> Region
Region

-- | Convert 'Region' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Region) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_vips_region_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Region -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Region
P.Nothing = Ptr GValue -> Ptr Region -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Region
forall a. Ptr a
FP.nullPtr :: FP.Ptr Region)
    gvalueSet_ Ptr GValue
gv (P.Just Region
obj) = Region -> (Ptr Region -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Region
obj (Ptr GValue -> Ptr Region -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Region)
gvalueGet_ Ptr GValue
gv = do
        Ptr Region
ptr <- Ptr GValue -> IO (Ptr Region)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Region)
        if Ptr Region
ptr Ptr Region -> Ptr Region -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Region
forall a. Ptr a
FP.nullPtr
        then Region -> Maybe Region
forall a. a -> Maybe a
P.Just (Region -> Maybe Region) -> IO Region -> IO (Maybe Region)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Region -> Region) -> Ptr Region -> IO Region
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Region -> Region
Region Ptr Region
ptr
        else Maybe Region -> IO (Maybe Region)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Region
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveRegionMethod (t :: Symbol) (o :: *) :: * where
    ResolveRegionMethod "argumentIsset" o = Vips.Object.ObjectArgumentIssetMethodInfo
    ResolveRegionMethod "argumentNeedsstring" o = Vips.Object.ObjectArgumentNeedsstringMethodInfo
    ResolveRegionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRegionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRegionMethod "build" o = Vips.Object.ObjectBuildMethodInfo
    ResolveRegionMethod "copy" o = RegionCopyMethodInfo
    ResolveRegionMethod "equalsregion" o = RegionEqualsregionMethodInfo
    ResolveRegionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveRegionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveRegionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveRegionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveRegionMethod "localCb" o = Vips.Object.ObjectLocalCbMethodInfo
    ResolveRegionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRegionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRegionMethod "preclose" o = Vips.Object.ObjectPrecloseMethodInfo
    ResolveRegionMethod "printDump" o = Vips.Object.ObjectPrintDumpMethodInfo
    ResolveRegionMethod "printName" o = Vips.Object.ObjectPrintNameMethodInfo
    ResolveRegionMethod "printSummary" o = Vips.Object.ObjectPrintSummaryMethodInfo
    ResolveRegionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRegionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRegionMethod "regionBlack" o = RegionRegionBlackMethodInfo
    ResolveRegionMethod "regionBuffer" o = RegionRegionBufferMethodInfo
    ResolveRegionMethod "regionFetch" o = RegionRegionFetchMethodInfo
    ResolveRegionMethod "regionHeight" o = RegionRegionHeightMethodInfo
    ResolveRegionMethod "regionImage" o = RegionRegionImageMethodInfo
    ResolveRegionMethod "regionInvalidate" o = RegionRegionInvalidateMethodInfo
    ResolveRegionMethod "regionPaint" o = RegionRegionPaintMethodInfo
    ResolveRegionMethod "regionPaintPel" o = RegionRegionPaintPelMethodInfo
    ResolveRegionMethod "regionPosition" o = RegionRegionPositionMethodInfo
    ResolveRegionMethod "regionPrepare" o = RegionRegionPrepareMethodInfo
    ResolveRegionMethod "regionPrepareTo" o = RegionRegionPrepareToMethodInfo
    ResolveRegionMethod "regionRegion" o = RegionRegionRegionMethodInfo
    ResolveRegionMethod "regionWidth" o = RegionRegionWidthMethodInfo
    ResolveRegionMethod "rewind" o = Vips.Object.ObjectRewindMethodInfo
    ResolveRegionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRegionMethod "sanity" o = Vips.Object.ObjectSanityMethodInfo
    ResolveRegionMethod "shrinkMethod" o = RegionShrinkMethodMethodInfo
    ResolveRegionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveRegionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveRegionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveRegionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveRegionMethod "unrefOutputs" o = Vips.Object.ObjectUnrefOutputsMethodInfo
    ResolveRegionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveRegionMethod "getArgumentFlags" o = Vips.Object.ObjectGetArgumentFlagsMethodInfo
    ResolveRegionMethod "getArgumentPriority" o = Vips.Object.ObjectGetArgumentPriorityMethodInfo
    ResolveRegionMethod "getArgumentToString" o = Vips.Object.ObjectGetArgumentToStringMethodInfo
    ResolveRegionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRegionMethod "getDescription" o = Vips.Object.ObjectGetDescriptionMethodInfo
    ResolveRegionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRegionMethod "setArgumentFromString" o = Vips.Object.ObjectSetArgumentFromStringMethodInfo
    ResolveRegionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRegionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveRegionMethod "setFromString" o = Vips.Object.ObjectSetFromStringMethodInfo
    ResolveRegionMethod "setRequired" o = Vips.Object.ObjectSetRequiredMethodInfo
    ResolveRegionMethod "setStatic" o = Vips.Object.ObjectSetStaticMethodInfo
    ResolveRegionMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveRegionMethod t Region, O.OverloadedMethod info Region p) => OL.IsLabel t (Region -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveRegionMethod t Region, O.OverloadedMethod info Region p, R.HasField t Region p) => R.HasField t Region p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveRegionMethod t Region, O.OverloadedMethodInfo info Region) => OL.IsLabel t (O.MethodProxy info Region) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Region
type instance O.AttributeList Region = RegionAttributeList
type RegionAttributeList = ('[ '("description", Vips.Object.ObjectDescriptionPropertyInfo), '("nickname", Vips.Object.ObjectNicknamePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Region = RegionSignalList
type RegionSignalList = ('[ '("close", Vips.Object.ObjectCloseSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("postbuild", Vips.Object.ObjectPostbuildSignalInfo), '("postclose", Vips.Object.ObjectPostcloseSignalInfo), '("preclose", Vips.Object.ObjectPrecloseSignalInfo)] :: [(Symbol, *)])

#endif

-- method Region::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "image"
--           , argType = TInterface Name { namespace = "Vips" , name = "Image" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "image to create this region on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vips" , name = "Region" })
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_new" vips_region_new :: 
    Ptr Vips.Image.Image ->                 -- image : TInterface (Name {namespace = "Vips", name = "Image"})
    IO (Ptr Region)

-- | Create a region. t'GI.Vips.Objects.Region.Region' s start out empty, you need to call
-- 'GI.Vips.Objects.Region.regionRegionPrepare' to fill them with pixels.
-- 
-- See also: 'GI.Vips.Objects.Region.regionRegionPrepare'.
regionNew ::
    (B.CallStack.HasCallStack, MonadIO m, Vips.Image.IsImage a) =>
    a
    -- ^ /@image@/: image to create this region on
    -> m Region
regionNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsImage a) =>
a -> m Region
regionNew a
image = IO Region -> m Region
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Region -> m Region) -> IO Region -> m Region
forall a b. (a -> b) -> a -> b
$ do
    Ptr Image
image' <- a -> IO (Ptr Image)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
image
    Ptr Region
result <- Ptr Image -> IO (Ptr Region)
vips_region_new Ptr Image
image'
    Text -> Ptr Region -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"regionNew" Ptr Region
result
    Region
result' <- ((ManagedPtr Region -> Region) -> Ptr Region -> IO Region
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Region -> Region
Region) Ptr Region
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
image
    Region -> IO Region
forall (m :: * -> *) a. Monad m => a -> m a
return Region
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Region::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reg"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "source region" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destination region" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "r"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#VipsRect of pixels you need to copy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "postion of @r in @dest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "postion of @r in @dest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_copy" vips_region_copy :: 
    Ptr Region ->                           -- reg : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr (Ptr Region) ->                     -- dest : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr Vips.Rect.Rect ->                   -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO ()

-- | Copy from one region to another. Copy area /@r@/ from inside /@reg@/ to /@dest@/,
-- positioning the area of pixels at /@x@/, /@y@/. The two regions must have pixels
-- which are the same size.
-- 
-- See also: 'GI.Vips.Objects.Region.regionRegionPaint'.
regionCopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
    a
    -- ^ /@reg@/: source region
    -> b
    -- ^ /@dest@/: destination region
    -> Vips.Rect.Rect
    -- ^ /@r@/: t'GI.Vips.Structs.Rect.Rect' of pixels you need to copy
    -> Int32
    -- ^ /@x@/: postion of /@r@/ in /@dest@/
    -> Int32
    -- ^ /@y@/: postion of /@r@/ in /@dest@/
    -> m (Region)
regionCopy :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
a -> b -> Rect -> Int32 -> Int32 -> m Region
regionCopy a
reg b
dest Rect
r Int32
x Int32
y = IO Region -> m Region
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Region -> m Region) -> IO Region -> m Region
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
reg' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
reg
    Ptr Region
dest' <- b -> IO (Ptr Region)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject b
dest
    Ptr (Ptr Region)
dest'' <- IO (Ptr (Ptr Region))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Region))
    Ptr (Ptr Region) -> Ptr Region -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Region)
dest'' Ptr Region
dest'
    Ptr Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    Ptr Region
-> Ptr (Ptr Region) -> Ptr Rect -> Int32 -> Int32 -> IO ()
vips_region_copy Ptr Region
reg' Ptr (Ptr Region)
dest'' Ptr Rect
r' Int32
x Int32
y
    Ptr Region
dest''' <- Ptr (Ptr Region) -> IO (Ptr Region)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Region)
dest''
    Region
dest'''' <- ((ManagedPtr Region -> Region) -> Ptr Region -> IO Region
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Region -> Region
Region) Ptr Region
dest'''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
reg
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
dest
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r
    Ptr (Ptr Region) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Region)
dest''
    Region -> IO Region
forall (m :: * -> *) a. Monad m => a -> m a
return Region
dest''''

#if defined(ENABLE_OVERLOADING)
data RegionCopyMethodInfo
instance (signature ~ (b -> Vips.Rect.Rect -> Int32 -> Int32 -> m (Region)), MonadIO m, IsRegion a, IsRegion b) => O.OverloadedMethod RegionCopyMethodInfo a signature where
    overloadedMethod = regionCopy

instance O.OverloadedMethodInfo RegionCopyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionCopy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionCopy"
        }


#endif

-- method Region::equalsregion
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reg1"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to test" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "reg2"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to test" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_equalsregion" vips_region_equalsregion :: 
    Ptr Region ->                           -- reg1 : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr Region ->                           -- reg2 : TInterface (Name {namespace = "Vips", name = "Region"})
    IO Int32

-- | Do two regions point to the same piece of image? ie.
-- 
-- >
-- >	VIPS_REGION_ADDR( reg1, x, y ) == VIPS_REGION_ADDR( reg2, x, y ) &&
-- >	*VIPS_REGION_ADDR( reg1, x, y ) ==
-- >		*VIPS_REGION_ADDR( reg2, x, y ) for all x, y, reg1, reg2.
regionEqualsregion ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
    a
    -- ^ /@reg1@/: region to test
    -> b
    -- ^ /@reg2@/: region to test
    -> m Int32
    -- ^ __Returns:__ non-zero on equality.
regionEqualsregion :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
a -> b -> m Int32
regionEqualsregion a
reg1 b
reg2 = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
reg1' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
reg1
    Ptr Region
reg2' <- b -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
reg2
    Int32
result <- Ptr Region -> Ptr Region -> IO Int32
vips_region_equalsregion Ptr Region
reg1' Ptr Region
reg2'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
reg1
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
reg2
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data RegionEqualsregionMethodInfo
instance (signature ~ (b -> m Int32), MonadIO m, IsRegion a, IsRegion b) => O.OverloadedMethod RegionEqualsregionMethodInfo a signature where
    overloadedMethod = regionEqualsregion

instance O.OverloadedMethodInfo RegionEqualsregionMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionEqualsregion",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionEqualsregion"
        }


#endif

-- method Region::region_black
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reg"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to operate upon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_black" vips_region_black :: 
    Ptr Region ->                           -- reg : TInterface (Name {namespace = "Vips", name = "Region"})
    IO ()

-- | Paints 0 into the valid part of /@reg@/.
-- 
-- See also: 'GI.Vips.Objects.Region.regionRegionPaint'.
regionRegionBlack ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@reg@/: region to operate upon
    -> m ()
regionRegionBlack :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegion a) =>
a -> m ()
regionRegionBlack a
reg = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
reg' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
reg
    Ptr Region -> IO ()
vips_region_black Ptr Region
reg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
reg
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RegionRegionBlackMethodInfo
instance (signature ~ (m ()), MonadIO m, IsRegion a) => O.OverloadedMethod RegionRegionBlackMethodInfo a signature where
    overloadedMethod = regionRegionBlack

instance O.OverloadedMethodInfo RegionRegionBlackMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionBlack",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionBlack"
        }


#endif

-- method Region::region_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reg"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to operate upon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#VipsRect of pixels you need to be able to address"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_buffer" vips_region_buffer :: 
    Ptr Region ->                           -- reg : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr Vips.Rect.Rect ->                   -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    IO Int32

-- | The region is transformed so that at least /@r@/ pixels are available as a
-- memory buffer that can be written to.
regionRegionBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@reg@/: region to operate upon
    -> Vips.Rect.Rect
    -- ^ /@r@/: t'GI.Vips.Structs.Rect.Rect' of pixels you need to be able to address
    -> m Int32
    -- ^ __Returns:__ 0 on success, or -1 for error.
regionRegionBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegion a) =>
a -> Rect -> m Int32
regionRegionBuffer a
reg Rect
r = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
reg' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
reg
    Ptr Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    Int32
result <- Ptr Region -> Ptr Rect -> IO Int32
vips_region_buffer Ptr Region
reg' Ptr Rect
r'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
reg
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data RegionRegionBufferMethodInfo
instance (signature ~ (Vips.Rect.Rect -> m Int32), MonadIO m, IsRegion a) => O.OverloadedMethod RegionRegionBufferMethodInfo a signature where
    overloadedMethod = regionRegionBuffer

instance O.OverloadedMethodInfo RegionRegionBufferMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionBuffer",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionBuffer"
        }


#endif

-- method Region::region_fetch
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "left"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "area of pixels to fetch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "top"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "area of pixels to fetch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "area of pixels to fetch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "area of pixels to fetch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt8)
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_fetch" vips_region_fetch :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "Vips", name = "Region"})
    Int32 ->                                -- left : TBasicType TInt
    Int32 ->                                -- top : TBasicType TInt
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    Word64 ->                               -- len : TBasicType TUInt64
    IO Word8

-- | Generate an area of pixels and return a copy. The result must be freed
-- with 'GI.GLib.Functions.free'. The requested area must be completely inside the image.
-- 
-- This is equivalent to 'GI.Vips.Objects.Region.regionRegionPrepare', followed by a memcpy. It is
-- convenient for language bindings.
regionRegionFetch ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -> Int32
    -- ^ /@left@/: area of pixels to fetch
    -> Int32
    -- ^ /@top@/: area of pixels to fetch
    -> Int32
    -- ^ /@width@/: area of pixels to fetch
    -> Int32
    -- ^ /@height@/: area of pixels to fetch
    -> Word64
    -> m Word8
    -- ^ __Returns:__ A copy of the pixel data.
regionRegionFetch :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegion a) =>
a -> Int32 -> Int32 -> Int32 -> Int32 -> Word64 -> m Word8
regionRegionFetch a
region Int32
left Int32
top Int32
width Int32
height Word64
len = IO Word8 -> m Word8
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    Word8
result <- Ptr Region
-> Int32 -> Int32 -> Int32 -> Int32 -> Word64 -> IO Word8
vips_region_fetch Ptr Region
region' Int32
left Int32
top Int32
width Int32
height Word64
len
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region
    Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result

#if defined(ENABLE_OVERLOADING)
data RegionRegionFetchMethodInfo
instance (signature ~ (Int32 -> Int32 -> Int32 -> Int32 -> Word64 -> m Word8), MonadIO m, IsRegion a) => O.OverloadedMethod RegionRegionFetchMethodInfo a signature where
    overloadedMethod = regionRegionFetch

instance O.OverloadedMethodInfo RegionRegionFetchMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionFetch",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionFetch"
        }


#endif

-- method Region::region_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "fetch height from this"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_height" vips_region_height :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "Vips", name = "Region"})
    IO Int32

-- | /No description available in the introspection data./
regionRegionHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@region@/: fetch height from this
    -> m Int32
    -- ^ __Returns:__ Height of the pixels held in region.
regionRegionHeight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegion a) =>
a -> m Int32
regionRegionHeight a
region = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    Int32
result <- Ptr Region -> IO Int32
vips_region_height Ptr Region
region'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data RegionRegionHeightMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsRegion a) => O.OverloadedMethod RegionRegionHeightMethodInfo a signature where
    overloadedMethod = regionRegionHeight

instance O.OverloadedMethodInfo RegionRegionHeightMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionHeight",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionHeight"
        }


#endif

-- method Region::region_image
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reg"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to operate upon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#VipsRect of pixels you need to be able to address"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_image" vips_region_image :: 
    Ptr Region ->                           -- reg : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr Vips.Rect.Rect ->                   -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    IO Int32

-- | The region is transformed so that at least /@r@/ pixels are available to be
-- read from the image. The image needs to be a memory buffer or represent a
-- file on disc that has been mapped or can be mapped.
regionRegionImage ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@reg@/: region to operate upon
    -> Vips.Rect.Rect
    -- ^ /@r@/: t'GI.Vips.Structs.Rect.Rect' of pixels you need to be able to address
    -> m Int32
    -- ^ __Returns:__ 0 on success, or -1 for error.
regionRegionImage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegion a) =>
a -> Rect -> m Int32
regionRegionImage a
reg Rect
r = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
reg' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
reg
    Ptr Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    Int32
result <- Ptr Region -> Ptr Rect -> IO Int32
vips_region_image Ptr Region
reg' Ptr Rect
r'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
reg
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data RegionRegionImageMethodInfo
instance (signature ~ (Vips.Rect.Rect -> m Int32), MonadIO m, IsRegion a) => O.OverloadedMethod RegionRegionImageMethodInfo a signature where
    overloadedMethod = regionRegionImage

instance O.OverloadedMethodInfo RegionRegionImageMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionImage",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionImage"
        }


#endif

-- method Region::region_invalidate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reg"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to invalidate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_invalidate" vips_region_invalidate :: 
    Ptr Region ->                           -- reg : TInterface (Name {namespace = "Vips", name = "Region"})
    IO ()

-- | Mark a region as containing invalid pixels. Calling this function means
-- that the next time 'GI.Vips.Objects.Region.regionRegionPrepare' is called, the region will be
-- recalculated.
-- 
-- This is faster than calling 'GI.Vips.Objects.Image.imageImageInvalidateAll', but obviously only
-- affects a single region.
-- 
-- See also: 'GI.Vips.Objects.Image.imageImageInvalidateAll', 'GI.Vips.Objects.Region.regionRegionPrepare'.
regionRegionInvalidate ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@reg@/: region to invalidate
    -> m ()
regionRegionInvalidate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegion a) =>
a -> m ()
regionRegionInvalidate a
reg = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
reg' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
reg
    Ptr Region -> IO ()
vips_region_invalidate Ptr Region
reg'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
reg
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RegionRegionInvalidateMethodInfo
instance (signature ~ (m ()), MonadIO m, IsRegion a) => O.OverloadedMethod RegionRegionInvalidateMethodInfo a signature where
    overloadedMethod = regionRegionInvalidate

instance O.OverloadedMethodInfo RegionRegionInvalidateMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionInvalidate",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionInvalidate"
        }


#endif

-- method Region::region_paint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reg"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to operate upon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "area to paint" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value to paint" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_paint" vips_region_paint :: 
    Ptr Region ->                           -- reg : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr Vips.Rect.Rect ->                   -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    Int32 ->                                -- value : TBasicType TInt
    IO ()

-- | Paints /@value@/ into /@reg@/ covering rectangle /@r@/.
-- /@r@/ is clipped against
-- /@reg@/->valid.
-- 
-- For int images, /@value@/ is
-- passed to @/memset()/@, so it usually needs to be 0 or 255. For float images,
-- value is cast to a float and copied in to each band element.
-- 
-- /@r@/ is clipped against
-- /@reg@/->valid.
-- 
-- See also: 'GI.Vips.Objects.Region.regionRegionBlack'.
regionRegionPaint ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@reg@/: region to operate upon
    -> Vips.Rect.Rect
    -- ^ /@r@/: area to paint
    -> Int32
    -- ^ /@value@/: value to paint
    -> m ()
regionRegionPaint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegion a) =>
a -> Rect -> Int32 -> m ()
regionRegionPaint a
reg Rect
r Int32
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
reg' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
reg
    Ptr Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    Ptr Region -> Ptr Rect -> Int32 -> IO ()
vips_region_paint Ptr Region
reg' Ptr Rect
r' Int32
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
reg
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RegionRegionPaintMethodInfo
instance (signature ~ (Vips.Rect.Rect -> Int32 -> m ()), MonadIO m, IsRegion a) => O.OverloadedMethod RegionRegionPaintMethodInfo a signature where
    overloadedMethod = regionRegionPaint

instance O.OverloadedMethodInfo RegionRegionPaintMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionPaint",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionPaint"
        }


#endif

-- method Region::region_paint_pel
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reg"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to operate upon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "area to paint" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ink"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value to paint" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_paint_pel" vips_region_paint_pel :: 
    Ptr Region ->                           -- reg : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr Vips.Rect.Rect ->                   -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    Word8 ->                                -- ink : TBasicType TUInt8
    IO ()

-- | Paints /@ink@/ into /@reg@/ covering rectangle /@r@/. /@r@/ is clipped against
-- /@reg@/->valid.
-- 
-- /@ink@/ should be a byte array of the same size as an image pixel containing
-- the binary value to write into the pixels.
-- 
-- See also: 'GI.Vips.Objects.Region.regionRegionPaint'.
regionRegionPaintPel ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@reg@/: region to operate upon
    -> Vips.Rect.Rect
    -- ^ /@r@/: area to paint
    -> Word8
    -- ^ /@ink@/: value to paint
    -> m ()
regionRegionPaintPel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegion a) =>
a -> Rect -> Word8 -> m ()
regionRegionPaintPel a
reg Rect
r Word8
ink = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
reg' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
reg
    Ptr Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    Ptr Region -> Ptr Rect -> Word8 -> IO ()
vips_region_paint_pel Ptr Region
reg' Ptr Rect
r' Word8
ink
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
reg
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RegionRegionPaintPelMethodInfo
instance (signature ~ (Vips.Rect.Rect -> Word8 -> m ()), MonadIO m, IsRegion a) => O.OverloadedMethod RegionRegionPaintPelMethodInfo a signature where
    overloadedMethod = regionRegionPaintPel

instance O.OverloadedMethodInfo RegionRegionPaintPelMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionPaintPel",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionPaintPel"
        }


#endif

-- method Region::region_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reg"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to operate upon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position to move to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position to move to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_position" vips_region_position :: 
    Ptr Region ->                           -- reg : TInterface (Name {namespace = "Vips", name = "Region"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO Int32

-- | Set the position of a region. This only affects reg->valid, ie. the way
-- pixels are addressed, not reg->data, the pixels which are addressed. Clip
-- against the size of the image. Do not allow negative positions, or
-- positions outside the image.
regionRegionPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@reg@/: region to operate upon
    -> Int32
    -- ^ /@x@/: position to move to
    -> Int32
    -- ^ /@y@/: position to move to
    -> m Int32
    -- ^ __Returns:__ 0 on success, or -1 for error.
regionRegionPosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegion a) =>
a -> Int32 -> Int32 -> m Int32
regionRegionPosition a
reg Int32
x Int32
y = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
reg' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
reg
    Int32
result <- Ptr Region -> Int32 -> Int32 -> IO Int32
vips_region_position Ptr Region
reg' Int32
x Int32
y
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
reg
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data RegionRegionPositionMethodInfo
instance (signature ~ (Int32 -> Int32 -> m Int32), MonadIO m, IsRegion a) => O.OverloadedMethod RegionRegionPositionMethodInfo a signature where
    overloadedMethod = regionRegionPosition

instance O.OverloadedMethodInfo RegionRegionPositionMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionPosition",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionPosition"
        }


#endif

-- method Region::region_prepare
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reg"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to prepare" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#VipsRect of pixels you need to be able to address"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_prepare" vips_region_prepare :: 
    Ptr Region ->                           -- reg : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr Vips.Rect.Rect ->                   -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    IO Int32

-- | 'GI.Vips.Objects.Region.regionRegionPrepare' fills /@reg@/ with pixels. After calling,
-- you can address at least the area /@r@/ with @/VIPS_REGION_ADDR()/@ and get
-- valid pixels.
-- 
-- 'GI.Vips.Objects.Region.regionRegionPrepare' runs in-line, that is, computation is done by
-- the calling thread, no new threads are involved, and computation
-- blocks until the pixels are ready.
-- 
-- Use @/vips_sink_screen()/@ to calculate an area of pixels in the
-- background.
-- 
-- See also: @/vips_sink_screen()/@,
-- 'GI.Vips.Objects.Region.regionRegionPrepareTo'.
regionRegionPrepare ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@reg@/: region to prepare
    -> Vips.Rect.Rect
    -- ^ /@r@/: t'GI.Vips.Structs.Rect.Rect' of pixels you need to be able to address
    -> m Int32
    -- ^ __Returns:__ 0 on success, or -1 on error.
regionRegionPrepare :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegion a) =>
a -> Rect -> m Int32
regionRegionPrepare a
reg Rect
r = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
reg' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
reg
    Ptr Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    Int32
result <- Ptr Region -> Ptr Rect -> IO Int32
vips_region_prepare Ptr Region
reg' Ptr Rect
r'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
reg
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data RegionRegionPrepareMethodInfo
instance (signature ~ (Vips.Rect.Rect -> m Int32), MonadIO m, IsRegion a) => O.OverloadedMethod RegionRegionPrepareMethodInfo a signature where
    overloadedMethod = regionRegionPrepare

instance O.OverloadedMethodInfo RegionRegionPrepareMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionPrepare",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionPrepare"
        }


#endif

-- method Region::region_prepare_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reg"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to prepare" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to write to" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "r"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#VipsRect of pixels you need to be able to address"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "postion of @r in @dest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "postion of @r in @dest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_prepare_to" vips_region_prepare_to :: 
    Ptr Region ->                           -- reg : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr (Ptr Region) ->                     -- dest : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr Vips.Rect.Rect ->                   -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO Int32

-- | Like 'GI.Vips.Objects.Region.regionRegionPrepare': fill /@reg@/ with the pixels in area /@r@/.
-- 
-- Unlike 'GI.Vips.Objects.Region.regionRegionPrepare', rather than writing the result to /@reg@/, the
-- pixels are written into /@dest@/ at offset /@x@/, /@y@/.
-- 
-- Also unlike 'GI.Vips.Objects.Region.regionRegionPrepare', /@dest@/ is not set up for writing for
-- you with 'GI.Vips.Objects.Region.regionRegionBuffer'. You can
-- point /@dest@/ at anything, and pixels really will be written there.
-- This makes 'GI.Vips.Objects.Region.regionRegionPrepareTo' useful for making the ends of
-- pipelines.
-- 
-- See also: 'GI.Vips.Objects.Region.regionRegionPrepare', @/vips_sink_disc()/@.
regionRegionPrepareTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
    a
    -- ^ /@reg@/: region to prepare
    -> b
    -- ^ /@dest@/: region to write to
    -> Vips.Rect.Rect
    -- ^ /@r@/: t'GI.Vips.Structs.Rect.Rect' of pixels you need to be able to address
    -> Int32
    -- ^ /@x@/: postion of /@r@/ in /@dest@/
    -> Int32
    -- ^ /@y@/: postion of /@r@/ in /@dest@/
    -> m ((Int32, Region))
    -- ^ __Returns:__ 0 on success, or -1 on error
regionRegionPrepareTo :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
a -> b -> Rect -> Int32 -> Int32 -> m (Int32, Region)
regionRegionPrepareTo a
reg b
dest Rect
r Int32
x Int32
y = IO (Int32, Region) -> m (Int32, Region)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Region) -> m (Int32, Region))
-> IO (Int32, Region) -> m (Int32, Region)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
reg' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
reg
    Ptr Region
dest' <- b -> IO (Ptr Region)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject b
dest
    Ptr (Ptr Region)
dest'' <- IO (Ptr (Ptr Region))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Region))
    Ptr (Ptr Region) -> Ptr Region -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Region)
dest'' Ptr Region
dest'
    Ptr Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    Int32
result <- Ptr Region
-> Ptr (Ptr Region) -> Ptr Rect -> Int32 -> Int32 -> IO Int32
vips_region_prepare_to Ptr Region
reg' Ptr (Ptr Region)
dest'' Ptr Rect
r' Int32
x Int32
y
    Ptr Region
dest''' <- Ptr (Ptr Region) -> IO (Ptr Region)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Region)
dest''
    Region
dest'''' <- ((ManagedPtr Region -> Region) -> Ptr Region -> IO Region
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Region -> Region
Region) Ptr Region
dest'''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
reg
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
dest
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r
    Ptr (Ptr Region) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Region)
dest''
    (Int32, Region) -> IO (Int32, Region)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Region
dest'''')

#if defined(ENABLE_OVERLOADING)
data RegionRegionPrepareToMethodInfo
instance (signature ~ (b -> Vips.Rect.Rect -> Int32 -> Int32 -> m ((Int32, Region))), MonadIO m, IsRegion a, IsRegion b) => O.OverloadedMethod RegionRegionPrepareToMethodInfo a signature where
    overloadedMethod = regionRegionPrepareTo

instance O.OverloadedMethodInfo RegionRegionPrepareToMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionPrepareTo",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionPrepareTo"
        }


#endif

-- method Region::region_region
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "reg"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to operate upon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "region to connect to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#VipsRect of pixels you need to be able to address"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "postion of @r in @dest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "postion of @r in @dest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_region" vips_region_region :: 
    Ptr Region ->                           -- reg : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr Region ->                           -- dest : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr Vips.Rect.Rect ->                   -- r : TInterface (Name {namespace = "Vips", name = "Rect"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO Int32

-- | Make @/VIPS_REGION_ADDR()/@ on /@reg@/ go to /@dest@/ instead.
-- 
-- /@r@/ is the part of /@reg@/ which you want to be able to address (this
-- effectively becomes the valid field), (/@x@/, /@y@/) is the top LH corner of the
-- corresponding area in /@dest@/.
-- 
-- Performs all clipping necessary to ensure that /@reg@/->valid is indeed
-- valid.
-- 
-- If the region we attach to is moved or destroyed, we can be left with
-- dangling pointers! If the region we attach to is on another image, the
-- two images must have the same sizeof( pel ).
regionRegionRegion ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
    a
    -- ^ /@reg@/: region to operate upon
    -> b
    -- ^ /@dest@/: region to connect to
    -> Vips.Rect.Rect
    -- ^ /@r@/: t'GI.Vips.Structs.Rect.Rect' of pixels you need to be able to address
    -> Int32
    -- ^ /@x@/: postion of /@r@/ in /@dest@/
    -> Int32
    -- ^ /@y@/: postion of /@r@/ in /@dest@/
    -> m Int32
    -- ^ __Returns:__ 0 on success, or -1 for error.
regionRegionRegion :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
a -> b -> Rect -> Int32 -> Int32 -> m Int32
regionRegionRegion a
reg b
dest Rect
r Int32
x Int32
y = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
reg' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
reg
    Ptr Region
dest' <- b -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
dest
    Ptr Rect
r' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
r
    Int32
result <- Ptr Region -> Ptr Region -> Ptr Rect -> Int32 -> Int32 -> IO Int32
vips_region_region Ptr Region
reg' Ptr Region
dest' Ptr Rect
r' Int32
x Int32
y
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
reg
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
dest
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
r
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data RegionRegionRegionMethodInfo
instance (signature ~ (b -> Vips.Rect.Rect -> Int32 -> Int32 -> m Int32), MonadIO m, IsRegion a, IsRegion b) => O.OverloadedMethod RegionRegionRegionMethodInfo a signature where
    overloadedMethod = regionRegionRegion

instance O.OverloadedMethodInfo RegionRegionRegionMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionRegion",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionRegion"
        }


#endif

-- method Region::region_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "region"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "fetch width from this"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_width" vips_region_width :: 
    Ptr Region ->                           -- region : TInterface (Name {namespace = "Vips", name = "Region"})
    IO Int32

-- | /No description available in the introspection data./
regionRegionWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a) =>
    a
    -- ^ /@region@/: fetch width from this
    -> m Int32
    -- ^ __Returns:__ Width of the pixels held in region.
regionRegionWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegion a) =>
a -> m Int32
regionRegionWidth a
region = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
region' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
region
    Int32
result <- Ptr Region -> IO Int32
vips_region_width Ptr Region
region'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
region
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data RegionRegionWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsRegion a) => O.OverloadedMethod RegionRegionWidthMethodInfo a signature where
    overloadedMethod = regionRegionWidth

instance O.OverloadedMethodInfo RegionRegionWidthMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionRegionWidth",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionRegionWidth"
        }


#endif

-- method Region::shrink_method
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "from"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "source region" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "to"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "Region" }
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destination region" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TInterface Name { namespace = "Vips" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#VipsRect of pixels you need to copy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "method"
--           , argType =
--               TInterface Name { namespace = "Vips" , name = "RegionShrink" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "method to use when generating target pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "vips_region_shrink_method" vips_region_shrink_method :: 
    Ptr Region ->                           -- from : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr (Ptr Region) ->                     -- to : TInterface (Name {namespace = "Vips", name = "Region"})
    Ptr Vips.Rect.Rect ->                   -- target : TInterface (Name {namespace = "Vips", name = "Rect"})
    CUInt ->                                -- method : TInterface (Name {namespace = "Vips", name = "RegionShrink"})
    IO Int32

-- | Write the pixels /@target@/ in /@to@/ from the x2 larger area in /@from@/.
-- Non-complex uncoded images and LABQ only. Images with alpha (see
-- 'GI.Vips.Objects.Image.imageImageHasalpha') shrink with pixels scaled by alpha to avoid fringing.
-- 
-- /@method@/ selects the method used to do the 2x2 shrink.
-- 
-- See also: 'GI.Vips.Objects.Region.regionCopy'.
regionShrinkMethod ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
    a
    -- ^ /@from@/: source region
    -> b
    -- ^ /@to@/: destination region
    -> Vips.Rect.Rect
    -- ^ /@target@/: t'GI.Vips.Structs.Rect.Rect' of pixels you need to copy
    -> Vips.Enums.RegionShrink
    -- ^ /@method@/: method to use when generating target pixels
    -> m ((Int32, Region))
regionShrinkMethod :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRegion a, IsRegion b) =>
a -> b -> Rect -> RegionShrink -> m (Int32, Region)
regionShrinkMethod a
from b
to Rect
target RegionShrink
method = IO (Int32, Region) -> m (Int32, Region)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Region) -> m (Int32, Region))
-> IO (Int32, Region) -> m (Int32, Region)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Region
from' <- a -> IO (Ptr Region)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
from
    Ptr Region
to' <- b -> IO (Ptr Region)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject b
to
    Ptr (Ptr Region)
to'' <- IO (Ptr (Ptr Region))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Region))
    Ptr (Ptr Region) -> Ptr Region -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Region)
to'' Ptr Region
to'
    Ptr Rect
target' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
target
    let method' :: CUInt
method' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (RegionShrink -> Int) -> RegionShrink -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegionShrink -> Int
forall a. Enum a => a -> Int
fromEnum) RegionShrink
method
    Int32
result <- Ptr Region -> Ptr (Ptr Region) -> Ptr Rect -> CUInt -> IO Int32
vips_region_shrink_method Ptr Region
from' Ptr (Ptr Region)
to'' Ptr Rect
target' CUInt
method'
    Ptr Region
to''' <- Ptr (Ptr Region) -> IO (Ptr Region)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Region)
to''
    Region
to'''' <- ((ManagedPtr Region -> Region) -> Ptr Region -> IO Region
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Region -> Region
Region) Ptr Region
to'''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
from
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
to
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
target
    Ptr (Ptr Region) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Region)
to''
    (Int32, Region) -> IO (Int32, Region)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Region
to'''')

#if defined(ENABLE_OVERLOADING)
data RegionShrinkMethodMethodInfo
instance (signature ~ (b -> Vips.Rect.Rect -> Vips.Enums.RegionShrink -> m ((Int32, Region))), MonadIO m, IsRegion a, IsRegion b) => O.OverloadedMethod RegionShrinkMethodMethodInfo a signature where
    overloadedMethod = regionShrinkMethod

instance O.OverloadedMethodInfo RegionShrinkMethodMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vips.Objects.Region.regionShrinkMethod",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vips-8.0.1/docs/GI-Vips-Objects-Region.html#v:regionShrinkMethod"
        }


#endif