{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Gsk.Objects.BorderNode
    ( 

-- * Exported types
    BorderNode(..)                          ,
    IsBorderNode                            ,
    toBorderNode                            ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveBorderNodeMethod                 ,
#endif


-- ** new #method:new#

    borderNodeNew                           ,


-- ** peekColors #method:peekColors#

    borderNodePeekColors                    ,


-- ** peekOutline #method:peekOutline#

    borderNodePeekOutline                   ,


-- ** peekWidths #method:peekWidths#

    borderNodePeekWidths                    ,




    ) 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.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 GI.Gdk.Structs.RGBA as Gdk.RGBA
import {-# SOURCE #-} qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode
import {-# SOURCE #-} qualified GI.Gsk.Structs.RoundedRect as Gsk.RoundedRect

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

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

foreign import ccall "gsk_border_node_get_type"
    c_gsk_border_node_get_type :: IO B.Types.GType

instance B.Types.TypedObject BorderNode where
    glibType :: IO GType
glibType = IO GType
c_gsk_border_node_get_type

-- | Type class for types which can be safely cast to `BorderNode`, for instance with `toBorderNode`.
class (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf BorderNode o) => IsBorderNode o
instance (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf BorderNode o) => IsBorderNode o

instance O.HasParentTypes BorderNode
type instance O.ParentTypes BorderNode = '[Gsk.RenderNode.RenderNode]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveBorderNodeMethod (t :: Symbol) (o :: *) :: * where
    ResolveBorderNodeMethod "draw" o = Gsk.RenderNode.RenderNodeDrawMethodInfo
    ResolveBorderNodeMethod "ref" o = Gsk.RenderNode.RenderNodeRefMethodInfo
    ResolveBorderNodeMethod "serialize" o = Gsk.RenderNode.RenderNodeSerializeMethodInfo
    ResolveBorderNodeMethod "unref" o = Gsk.RenderNode.RenderNodeUnrefMethodInfo
    ResolveBorderNodeMethod "writeToFile" o = Gsk.RenderNode.RenderNodeWriteToFileMethodInfo
    ResolveBorderNodeMethod "getBounds" o = Gsk.RenderNode.RenderNodeGetBoundsMethodInfo
    ResolveBorderNodeMethod "getNodeType" o = Gsk.RenderNode.RenderNodeGetNodeTypeMethodInfo
    ResolveBorderNodeMethod l o = O.MethodResolutionFailed l o

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

#endif

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr BorderNode where
    boxedPtrCopy :: BorderNode -> IO BorderNode
boxedPtrCopy = BorderNode -> IO BorderNode
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: BorderNode -> IO ()
boxedPtrFree = \BorderNode
_x -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- method BorderNode::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "outline"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RoundedRect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GskRoundedRect describing the outline of the border"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "border_width"
--           , argType = TCArray False 4 (-1) (TBasicType TFloat)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the stroke width of the border on\n    the top, right, bottom and left side respectively."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "border_color"
--           , argType =
--               TCArray
--                 False
--                 4
--                 (-1)
--                 (TInterface Name { namespace = "Gdk" , name = "RGBA" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the color used on the top, right,\n    bottom and left side."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "BorderNode" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_border_node_new" gsk_border_node_new :: 
    Ptr Gsk.RoundedRect.RoundedRect ->      -- outline : TInterface (Name {namespace = "Gsk", name = "RoundedRect"})
    Ptr CFloat ->                           -- border_width : TCArray False 4 (-1) (TBasicType TFloat)
    Ptr Gdk.RGBA.RGBA ->                    -- border_color : TCArray False 4 (-1) (TInterface (Name {namespace = "Gdk", name = "RGBA"}))
    IO (Ptr BorderNode)

-- | Creates a t'GI.Gsk.Objects.RenderNode.RenderNode' that will stroke a border rectangle inside the
-- given /@outline@/. The 4 sides of the border can have different widths and
-- colors.
borderNodeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gsk.RoundedRect.RoundedRect
    -- ^ /@outline@/: a t'GI.Gsk.Structs.RoundedRect.RoundedRect' describing the outline of the border
    -> [Float]
    -- ^ /@borderWidth@/: the stroke width of the border on
    --     the top, right, bottom and left side respectively.
    -> [Gdk.RGBA.RGBA]
    -- ^ /@borderColor@/: the color used on the top, right,
    --     bottom and left side.
    -> m BorderNode
    -- ^ __Returns:__ A new t'GI.Gsk.Objects.RenderNode.RenderNode'
borderNodeNew :: RoundedRect -> [Float] -> [RGBA] -> m BorderNode
borderNodeNew RoundedRect
outline [Float]
borderWidth [RGBA]
borderColor = IO BorderNode -> m BorderNode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BorderNode -> m BorderNode) -> IO BorderNode -> m BorderNode
forall a b. (a -> b) -> a -> b
$ do
    Ptr RoundedRect
outline' <- RoundedRect -> IO (Ptr RoundedRect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RoundedRect
outline
    Ptr CFloat
borderWidth' <- ((Float -> CFloat) -> [Float] -> IO (Ptr CFloat)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Float]
borderWidth
    [Ptr RGBA]
borderColor' <- (RGBA -> IO (Ptr RGBA)) -> [RGBA] -> IO [Ptr RGBA]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RGBA -> IO (Ptr RGBA)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [RGBA]
borderColor
    Ptr RGBA
borderColor'' <- Int -> [Ptr RGBA] -> IO (Ptr RGBA)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
16 [Ptr RGBA]
borderColor'
    Ptr BorderNode
result <- Ptr RoundedRect -> Ptr CFloat -> Ptr RGBA -> IO (Ptr BorderNode)
gsk_border_node_new Ptr RoundedRect
outline' Ptr CFloat
borderWidth' Ptr RGBA
borderColor''
    Text -> Ptr BorderNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"borderNodeNew" Ptr BorderNode
result
    BorderNode
result' <- ((ManagedPtr BorderNode -> BorderNode)
-> Ptr BorderNode -> IO BorderNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr BorderNode -> BorderNode
BorderNode) Ptr BorderNode
result
    RoundedRect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RoundedRect
outline
    (RGBA -> IO ()) -> [RGBA] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RGBA -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [RGBA]
borderColor
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
borderWidth'
    Ptr RGBA -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr RGBA
borderColor''
    BorderNode -> IO BorderNode
forall (m :: * -> *) a. Monad m => a -> m a
return BorderNode
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BorderNode::peek_colors
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RenderNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "RGBA" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_border_node_peek_colors" gsk_border_node_peek_colors :: 
    Ptr Gsk.RenderNode.RenderNode ->        -- node : TInterface (Name {namespace = "Gsk", name = "RenderNode"})
    IO (Ptr Gdk.RGBA.RGBA)

-- | /No description available in the introspection data./
borderNodePeekColors ::
    (B.CallStack.HasCallStack, MonadIO m, Gsk.RenderNode.IsRenderNode a) =>
    a
    -> m Gdk.RGBA.RGBA
borderNodePeekColors :: a -> m RGBA
borderNodePeekColors a
node = IO RGBA -> m RGBA
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RGBA -> m RGBA) -> IO RGBA -> m RGBA
forall a b. (a -> b) -> a -> b
$ do
    Ptr RenderNode
node' <- a -> IO (Ptr RenderNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr RGBA
result <- Ptr RenderNode -> IO (Ptr RGBA)
gsk_border_node_peek_colors Ptr RenderNode
node'
    Text -> Ptr RGBA -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"borderNodePeekColors" Ptr RGBA
result
    RGBA
result' <- ((ManagedPtr RGBA -> RGBA) -> Ptr RGBA -> IO RGBA
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr RGBA -> RGBA
Gdk.RGBA.RGBA) Ptr RGBA
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    RGBA -> IO RGBA
forall (m :: * -> *) a. Monad m => a -> m a
return RGBA
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BorderNode::peek_outline
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RenderNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "RoundedRect" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_border_node_peek_outline" gsk_border_node_peek_outline :: 
    Ptr Gsk.RenderNode.RenderNode ->        -- node : TInterface (Name {namespace = "Gsk", name = "RenderNode"})
    IO (Ptr Gsk.RoundedRect.RoundedRect)

-- | /No description available in the introspection data./
borderNodePeekOutline ::
    (B.CallStack.HasCallStack, MonadIO m, Gsk.RenderNode.IsRenderNode a) =>
    a
    -> m Gsk.RoundedRect.RoundedRect
borderNodePeekOutline :: a -> m RoundedRect
borderNodePeekOutline a
node = IO RoundedRect -> m RoundedRect
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RoundedRect -> m RoundedRect)
-> IO RoundedRect -> m RoundedRect
forall a b. (a -> b) -> a -> b
$ do
    Ptr RenderNode
node' <- a -> IO (Ptr RenderNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr RoundedRect
result <- Ptr RenderNode -> IO (Ptr RoundedRect)
gsk_border_node_peek_outline Ptr RenderNode
node'
    Text -> Ptr RoundedRect -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"borderNodePeekOutline" Ptr RoundedRect
result
    RoundedRect
result' <- ((ManagedPtr RoundedRect -> RoundedRect)
-> Ptr RoundedRect -> IO RoundedRect
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr RoundedRect -> RoundedRect
Gsk.RoundedRect.RoundedRect) Ptr RoundedRect
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    RoundedRect -> IO RoundedRect
forall (m :: * -> *) a. Monad m => a -> m a
return RoundedRect
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BorderNode::peek_widths
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RenderNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "gsk_border_node_peek_widths" gsk_border_node_peek_widths :: 
    Ptr Gsk.RenderNode.RenderNode ->        -- node : TInterface (Name {namespace = "Gsk", name = "RenderNode"})
    IO CFloat

-- | /No description available in the introspection data./
borderNodePeekWidths ::
    (B.CallStack.HasCallStack, MonadIO m, Gsk.RenderNode.IsRenderNode a) =>
    a
    -> m Float
borderNodePeekWidths :: a -> m Float
borderNodePeekWidths a
node = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr RenderNode
node' <- a -> IO (Ptr RenderNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    CFloat
result <- Ptr RenderNode -> IO CFloat
gsk_border_node_peek_widths Ptr RenderNode
node'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
#endif