{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The Navigation interface is used for creating and injecting navigation related
-- events such as mouse button presses, cursor motion and key presses. The associated
-- library also provides methods for parsing received events, and for sending and
-- receiving navigation related bus events. One main usecase is DVD menu navigation.
-- 
-- The main parts of the API are:
-- 
-- * The GstNavigation interface, implemented by elements which provide an application
--   with the ability to create and inject navigation events into the pipeline.
-- * GstNavigation event handling API. GstNavigation events are created in response to
--   calls on a GstNavigation interface implementation, and sent in the pipeline. Upstream
--   elements can use the navigation event API functions to parse the contents of received
--   messages.
-- 
-- * GstNavigation message handling API. GstNavigation messages may be sent on the message
--   bus to inform applications of navigation related changes in the pipeline, such as the
--   mouse moving over a clickable region, or the set of available angles changing.
-- 
-- The GstNavigation message functions provide functions for creating and parsing
-- custom bus messages for signaling GstNavigation changes.

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

module GI.GstVideo.Interfaces.Navigation
    ( 

-- * Exported types
    Navigation(..)                          ,
    IsNavigation                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [sendCommand]("GI.GstVideo.Interfaces.Navigation#g:method:sendCommand"), [sendEvent]("GI.GstVideo.Interfaces.Navigation#g:method:sendEvent"), [sendKeyEvent]("GI.GstVideo.Interfaces.Navigation#g:method:sendKeyEvent"), [sendMouseEvent]("GI.GstVideo.Interfaces.Navigation#g:method:sendMouseEvent"), [sendMouseScrollEvent]("GI.GstVideo.Interfaces.Navigation#g:method:sendMouseScrollEvent").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveNavigationMethod                 ,
#endif

-- ** eventGetType #method:eventGetType#

    navigationEventGetType                  ,


-- ** eventParseCommand #method:eventParseCommand#

    navigationEventParseCommand             ,


-- ** eventParseKeyEvent #method:eventParseKeyEvent#

    navigationEventParseKeyEvent            ,


-- ** eventParseMouseButtonEvent #method:eventParseMouseButtonEvent#

    navigationEventParseMouseButtonEvent    ,


-- ** eventParseMouseMoveEvent #method:eventParseMouseMoveEvent#

    navigationEventParseMouseMoveEvent      ,


-- ** eventParseMouseScrollEvent #method:eventParseMouseScrollEvent#

    navigationEventParseMouseScrollEvent    ,


-- ** messageGetType #method:messageGetType#

    navigationMessageGetType                ,


-- ** messageNewAnglesChanged #method:messageNewAnglesChanged#

    navigationMessageNewAnglesChanged       ,


-- ** messageNewCommandsChanged #method:messageNewCommandsChanged#

    navigationMessageNewCommandsChanged     ,


-- ** messageNewEvent #method:messageNewEvent#

    navigationMessageNewEvent               ,


-- ** messageNewMouseOver #method:messageNewMouseOver#

    navigationMessageNewMouseOver           ,


-- ** messageParseAnglesChanged #method:messageParseAnglesChanged#

    navigationMessageParseAnglesChanged     ,


-- ** messageParseEvent #method:messageParseEvent#

    navigationMessageParseEvent             ,


-- ** messageParseMouseOver #method:messageParseMouseOver#

    navigationMessageParseMouseOver         ,


-- ** queryGetType #method:queryGetType#

    navigationQueryGetType                  ,


-- ** queryNewAngles #method:queryNewAngles#

    navigationQueryNewAngles                ,


-- ** queryNewCommands #method:queryNewCommands#

    navigationQueryNewCommands              ,


-- ** queryParseAngles #method:queryParseAngles#

    navigationQueryParseAngles              ,


-- ** queryParseCommandsLength #method:queryParseCommandsLength#

    navigationQueryParseCommandsLength      ,


-- ** queryParseCommandsNth #method:queryParseCommandsNth#

    navigationQueryParseCommandsNth         ,


-- ** querySetAngles #method:querySetAngles#

    navigationQuerySetAngles                ,


-- ** querySetCommandsv #method:querySetCommandsv#

    navigationQuerySetCommandsv             ,


-- ** sendCommand #method:sendCommand#

#if defined(ENABLE_OVERLOADING)
    NavigationSendCommandMethodInfo         ,
#endif
    navigationSendCommand                   ,


-- ** sendEvent #method:sendEvent#

#if defined(ENABLE_OVERLOADING)
    NavigationSendEventMethodInfo           ,
#endif
    navigationSendEvent                     ,


-- ** sendKeyEvent #method:sendKeyEvent#

#if defined(ENABLE_OVERLOADING)
    NavigationSendKeyEventMethodInfo        ,
#endif
    navigationSendKeyEvent                  ,


-- ** sendMouseEvent #method:sendMouseEvent#

#if defined(ENABLE_OVERLOADING)
    NavigationSendMouseEventMethodInfo      ,
#endif
    navigationSendMouseEvent                ,


-- ** sendMouseScrollEvent #method:sendMouseScrollEvent#

#if defined(ENABLE_OVERLOADING)
    NavigationSendMouseScrollEventMethodInfo,
#endif
    navigationSendMouseScrollEvent          ,




    ) 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.Gst.Objects.Object as Gst.Object
import qualified GI.Gst.Structs.Event as Gst.Event
import qualified GI.Gst.Structs.Message as Gst.Message
import qualified GI.Gst.Structs.Query as Gst.Query
import qualified GI.Gst.Structs.Structure as Gst.Structure
import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums

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

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

-- | Type class for types which implement `Navigation`.
class (ManagedPtrNewtype o, O.IsDescendantOf Navigation o) => IsNavigation o
instance (ManagedPtrNewtype o, O.IsDescendantOf Navigation o) => IsNavigation o
-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr Navigation where
    boxedPtrCopy :: Navigation -> IO Navigation
boxedPtrCopy = Navigation -> IO Navigation
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: Navigation -> IO ()
boxedPtrFree = \Navigation
_x -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


#if defined(ENABLE_OVERLOADING)
type family ResolveNavigationMethod (t :: Symbol) (o :: *) :: * where
    ResolveNavigationMethod "sendCommand" o = NavigationSendCommandMethodInfo
    ResolveNavigationMethod "sendEvent" o = NavigationSendEventMethodInfo
    ResolveNavigationMethod "sendKeyEvent" o = NavigationSendKeyEventMethodInfo
    ResolveNavigationMethod "sendMouseEvent" o = NavigationSendMouseEventMethodInfo
    ResolveNavigationMethod "sendMouseScrollEvent" o = NavigationSendMouseScrollEventMethodInfo
    ResolveNavigationMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveNavigationMethod t Navigation, O.OverloadedMethod info Navigation p) => OL.IsLabel t (Navigation -> 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 ~ ResolveNavigationMethod t Navigation, O.OverloadedMethod info Navigation p, R.HasField t Navigation p) => R.HasField t Navigation p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- method Navigation::send_command
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "navigation"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "Navigation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The navigation interface instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "command"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "NavigationCommand" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The command to issue"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_send_command" gst_navigation_send_command :: 
    Ptr Navigation ->                       -- navigation : TInterface (Name {namespace = "GstVideo", name = "Navigation"})
    CUInt ->                                -- command : TInterface (Name {namespace = "GstVideo", name = "NavigationCommand"})
    IO ()

-- | Sends the indicated command to the navigation interface.
navigationSendCommand ::
    (B.CallStack.HasCallStack, MonadIO m, IsNavigation a) =>
    a
    -- ^ /@navigation@/: The navigation interface instance
    -> GstVideo.Enums.NavigationCommand
    -- ^ /@command@/: The command to issue
    -> m ()
navigationSendCommand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNavigation a) =>
a -> NavigationCommand -> m ()
navigationSendCommand a
navigation NavigationCommand
command = 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 Navigation
navigation' <- a -> IO (Ptr Navigation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
navigation
    let command' :: CUInt
command' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (NavigationCommand -> Int) -> NavigationCommand -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavigationCommand -> Int
forall a. Enum a => a -> Int
fromEnum) NavigationCommand
command
    Ptr Navigation -> CUInt -> IO ()
gst_navigation_send_command Ptr Navigation
navigation' CUInt
command'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
navigation
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NavigationSendCommandMethodInfo
instance (signature ~ (GstVideo.Enums.NavigationCommand -> m ()), MonadIO m, IsNavigation a) => O.OverloadedMethod NavigationSendCommandMethodInfo a signature where
    overloadedMethod = navigationSendCommand

instance O.OverloadedMethodInfo NavigationSendCommandMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Interfaces.Navigation.navigationSendCommand",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Interfaces-Navigation.html#v:navigationSendCommand"
        }


#endif

-- method Navigation::send_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "navigation"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "Navigation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_send_event" gst_navigation_send_event :: 
    Ptr Navigation ->                       -- navigation : TInterface (Name {namespace = "GstVideo", name = "Navigation"})
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | /No description available in the introspection data./
navigationSendEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsNavigation a) =>
    a
    -> Gst.Structure.Structure
    -> m ()
navigationSendEvent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNavigation a) =>
a -> Structure -> m ()
navigationSendEvent a
navigation Structure
structure = 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 Navigation
navigation' <- a -> IO (Ptr Navigation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
navigation
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
structure
    Ptr Navigation -> Ptr Structure -> IO ()
gst_navigation_send_event Ptr Navigation
navigation' Ptr Structure
structure'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
navigation
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NavigationSendEventMethodInfo
instance (signature ~ (Gst.Structure.Structure -> m ()), MonadIO m, IsNavigation a) => O.OverloadedMethod NavigationSendEventMethodInfo a signature where
    overloadedMethod = navigationSendEvent

instance O.OverloadedMethodInfo NavigationSendEventMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Interfaces.Navigation.navigationSendEvent",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Interfaces-Navigation.html#v:navigationSendEvent"
        }


#endif

-- method Navigation::send_key_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "navigation"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "Navigation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The navigation interface instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The type of the key event. Recognised values are \"key-press\" and\n\"key-release\""
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Character representation of the key. This is typically as produced\nby XKeysymToString."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_send_key_event" gst_navigation_send_key_event :: 
    Ptr Navigation ->                       -- navigation : TInterface (Name {namespace = "GstVideo", name = "Navigation"})
    CString ->                              -- event : TBasicType TUTF8
    CString ->                              -- key : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
navigationSendKeyEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsNavigation a) =>
    a
    -- ^ /@navigation@/: The navigation interface instance
    -> T.Text
    -- ^ /@event@/: The type of the key event. Recognised values are \"key-press\" and
    -- \"key-release\"
    -> T.Text
    -- ^ /@key@/: Character representation of the key. This is typically as produced
    -- by XKeysymToString.
    -> m ()
navigationSendKeyEvent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNavigation a) =>
a -> Text -> Text -> m ()
navigationSendKeyEvent a
navigation Text
event Text
key = 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 Navigation
navigation' <- a -> IO (Ptr Navigation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
navigation
    CString
event' <- Text -> IO CString
textToCString Text
event
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr Navigation -> CString -> CString -> IO ()
gst_navigation_send_key_event Ptr Navigation
navigation' CString
event' CString
key'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
navigation
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
event'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NavigationSendKeyEventMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsNavigation a) => O.OverloadedMethod NavigationSendKeyEventMethodInfo a signature where
    overloadedMethod = navigationSendKeyEvent

instance O.OverloadedMethodInfo NavigationSendKeyEventMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Interfaces.Navigation.navigationSendKeyEvent",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Interfaces-Navigation.html#v:navigationSendKeyEvent"
        }


#endif

-- method Navigation::send_mouse_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "navigation"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "Navigation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The navigation interface instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The type of mouse event, as a text string. Recognised values are\n\"mouse-button-press\", \"mouse-button-release\" and \"mouse-move\"."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "button"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The button number of the button being pressed or released. Pass 0\nfor mouse-move events."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The x coordinate of the mouse event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The y coordinate of the mouse event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_send_mouse_event" gst_navigation_send_mouse_event :: 
    Ptr Navigation ->                       -- navigation : TInterface (Name {namespace = "GstVideo", name = "Navigation"})
    CString ->                              -- event : TBasicType TUTF8
    Int32 ->                                -- button : TBasicType TInt
    CDouble ->                              -- x : TBasicType TDouble
    CDouble ->                              -- y : TBasicType TDouble
    IO ()

-- | Sends a mouse event to the navigation interface. Mouse event coordinates
-- are sent relative to the display space of the related output area. This is
-- usually the size in pixels of the window associated with the element
-- implementing the t'GI.GstVideo.Interfaces.Navigation.Navigation' interface.
navigationSendMouseEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsNavigation a) =>
    a
    -- ^ /@navigation@/: The navigation interface instance
    -> T.Text
    -- ^ /@event@/: The type of mouse event, as a text string. Recognised values are
    -- \"mouse-button-press\", \"mouse-button-release\" and \"mouse-move\".
    -> Int32
    -- ^ /@button@/: The button number of the button being pressed or released. Pass 0
    -- for mouse-move events.
    -> Double
    -- ^ /@x@/: The x coordinate of the mouse event.
    -> Double
    -- ^ /@y@/: The y coordinate of the mouse event.
    -> m ()
navigationSendMouseEvent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNavigation a) =>
a -> Text -> Int32 -> Double -> Double -> m ()
navigationSendMouseEvent a
navigation Text
event Int32
button Double
x Double
y = 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 Navigation
navigation' <- a -> IO (Ptr Navigation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
navigation
    CString
event' <- Text -> IO CString
textToCString Text
event
    let x' :: CDouble
x' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    let y' :: CDouble
y' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y
    Ptr Navigation -> CString -> Int32 -> CDouble -> CDouble -> IO ()
gst_navigation_send_mouse_event Ptr Navigation
navigation' CString
event' Int32
button CDouble
x' CDouble
y'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
navigation
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
event'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NavigationSendMouseEventMethodInfo
instance (signature ~ (T.Text -> Int32 -> Double -> Double -> m ()), MonadIO m, IsNavigation a) => O.OverloadedMethod NavigationSendMouseEventMethodInfo a signature where
    overloadedMethod = navigationSendMouseEvent

instance O.OverloadedMethodInfo NavigationSendMouseEventMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Interfaces.Navigation.navigationSendMouseEvent",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Interfaces-Navigation.html#v:navigationSendMouseEvent"
        }


#endif

-- method Navigation::send_mouse_scroll_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "navigation"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "Navigation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The navigation interface instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The x coordinate of the mouse event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The y coordinate of the mouse event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "delta_x"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The delta_x coordinate of the mouse event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "delta_y"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The delta_y coordinate of the mouse event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_send_mouse_scroll_event" gst_navigation_send_mouse_scroll_event :: 
    Ptr Navigation ->                       -- navigation : TInterface (Name {namespace = "GstVideo", name = "Navigation"})
    CDouble ->                              -- x : TBasicType TDouble
    CDouble ->                              -- y : TBasicType TDouble
    CDouble ->                              -- delta_x : TBasicType TDouble
    CDouble ->                              -- delta_y : TBasicType TDouble
    IO ()

-- | Sends a mouse scroll event to the navigation interface. Mouse event coordinates
-- are sent relative to the display space of the related output area. This is
-- usually the size in pixels of the window associated with the element
-- implementing the t'GI.GstVideo.Interfaces.Navigation.Navigation' interface.
-- 
-- /Since: 1.18/
navigationSendMouseScrollEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsNavigation a) =>
    a
    -- ^ /@navigation@/: The navigation interface instance
    -> Double
    -- ^ /@x@/: The x coordinate of the mouse event.
    -> Double
    -- ^ /@y@/: The y coordinate of the mouse event.
    -> Double
    -- ^ /@deltaX@/: The delta_x coordinate of the mouse event.
    -> Double
    -- ^ /@deltaY@/: The delta_y coordinate of the mouse event.
    -> m ()
navigationSendMouseScrollEvent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNavigation a) =>
a -> Double -> Double -> Double -> Double -> m ()
navigationSendMouseScrollEvent a
navigation Double
x Double
y Double
deltaX Double
deltaY = 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 Navigation
navigation' <- a -> IO (Ptr Navigation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
navigation
    let x' :: CDouble
x' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    let y' :: CDouble
y' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
y
    let deltaX' :: CDouble
deltaX' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
deltaX
    let deltaY' :: CDouble
deltaY' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
deltaY
    Ptr Navigation -> CDouble -> CDouble -> CDouble -> CDouble -> IO ()
gst_navigation_send_mouse_scroll_event Ptr Navigation
navigation' CDouble
x' CDouble
y' CDouble
deltaX' CDouble
deltaY'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
navigation
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NavigationSendMouseScrollEventMethodInfo
instance (signature ~ (Double -> Double -> Double -> Double -> m ()), MonadIO m, IsNavigation a) => O.OverloadedMethod NavigationSendMouseScrollEventMethodInfo a signature where
    overloadedMethod = navigationSendMouseScrollEvent

instance O.OverloadedMethodInfo NavigationSendMouseScrollEventMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Interfaces.Navigation.navigationSendMouseScrollEvent",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Interfaces-Navigation.html#v:navigationSendMouseScrollEvent"
        }


#endif

-- method Navigation::event_get_type
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstEvent to inspect."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "NavigationEventType" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_event_get_type" gst_navigation_event_get_type :: 
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO CUInt

-- | Inspect a t'GI.Gst.Structs.Event.Event' and return the t'GI.GstVideo.Enums.NavigationEventType' of the event, or
-- @/GST_NAVIGATION_EVENT_INVALID/@ if the event is not a t'GI.GstVideo.Interfaces.Navigation.Navigation' event.
navigationEventGetType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Event.Event
    -- ^ /@event@/: A t'GI.Gst.Structs.Event.Event' to inspect.
    -> m GstVideo.Enums.NavigationEventType
navigationEventGetType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m NavigationEventType
navigationEventGetType Event
event = IO NavigationEventType -> m NavigationEventType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NavigationEventType -> m NavigationEventType)
-> IO NavigationEventType -> m NavigationEventType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    CUInt
result <- Ptr Event -> IO CUInt
gst_navigation_event_get_type Ptr Event
event'
    let result' :: NavigationEventType
result' = (Int -> NavigationEventType
forall a. Enum a => Int -> a
toEnum (Int -> NavigationEventType)
-> (CUInt -> Int) -> CUInt -> NavigationEventType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    NavigationEventType -> IO NavigationEventType
forall (m :: * -> *) a. Monad m => a -> m a
return NavigationEventType
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::event_parse_command
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstEvent to inspect."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "command"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "NavigationCommand" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Pointer to GstNavigationCommand to receive the\n    type of the navigation event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_event_parse_command" gst_navigation_event_parse_command :: 
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CUInt ->                            -- command : TInterface (Name {namespace = "GstVideo", name = "NavigationCommand"})
    IO CInt

-- | Inspect a t'GI.GstVideo.Interfaces.Navigation.Navigation' command event and retrieve the enum value of the
-- associated command.
navigationEventParseCommand ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Event.Event
    -- ^ /@event@/: A t'GI.Gst.Structs.Event.Event' to inspect.
    -> m ((Bool, GstVideo.Enums.NavigationCommand))
    -- ^ __Returns:__ TRUE if the navigation command could be extracted, otherwise FALSE.
navigationEventParseCommand :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Bool, NavigationCommand)
navigationEventParseCommand Event
event = IO (Bool, NavigationCommand) -> m (Bool, NavigationCommand)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, NavigationCommand) -> m (Bool, NavigationCommand))
-> IO (Bool, NavigationCommand) -> m (Bool, NavigationCommand)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CUInt
command <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr Event -> Ptr CUInt -> IO CInt
gst_navigation_event_parse_command Ptr Event
event' Ptr CUInt
command
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CUInt
command' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
command
    let command'' :: NavigationCommand
command'' = (Int -> NavigationCommand
forall a. Enum a => Int -> a
toEnum (Int -> NavigationCommand)
-> (CUInt -> Int) -> CUInt -> NavigationCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
command'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
command
    (Bool, NavigationCommand) -> IO (Bool, NavigationCommand)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', NavigationCommand
command'')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::event_parse_key_event
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstEvent to inspect."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A pointer to a location to receive\n    the string identifying the key press. The returned string is owned by the\n    event, and valid only until the event is unreffed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_event_parse_key_event" gst_navigation_event_parse_key_event :: 
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CString ->                          -- key : TBasicType TUTF8
    IO CInt

-- | /No description available in the introspection data./
navigationEventParseKeyEvent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Event.Event
    -- ^ /@event@/: A t'GI.Gst.Structs.Event.Event' to inspect.
    -> m ((Bool, T.Text))
navigationEventParseKeyEvent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Bool, Text)
navigationEventParseKeyEvent Event
event = IO (Bool, Text) -> m (Bool, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Text) -> m (Bool, Text))
-> IO (Bool, Text) -> m (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CString
key <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    CInt
result <- Ptr Event -> Ptr CString -> IO CInt
gst_navigation_event_parse_key_event Ptr Event
event' Ptr CString
key
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString
key' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
key
    Text
key'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
key'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
key
    (Bool, Text) -> IO (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Text
key'')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::event_parse_mouse_button_event
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstEvent to inspect."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "button"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Pointer to a gint that will receive the button\n    number associated with the event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Pointer to a gdouble to receive the x coordinate of the\n    mouse button event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Pointer to a gdouble to receive the y coordinate of the\n    mouse button event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_event_parse_mouse_button_event" gst_navigation_event_parse_mouse_button_event :: 
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr Int32 ->                            -- button : TBasicType TInt
    Ptr CDouble ->                          -- x : TBasicType TDouble
    Ptr CDouble ->                          -- y : TBasicType TDouble
    IO CInt

-- | Retrieve the details of either a t'GI.GstVideo.Interfaces.Navigation.Navigation' mouse button press event or
-- a mouse button release event. Determine which type the event is using
-- 'GI.GstVideo.Functions.navigationEventGetType' to retrieve the t'GI.GstVideo.Enums.NavigationEventType'.
navigationEventParseMouseButtonEvent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Event.Event
    -- ^ /@event@/: A t'GI.Gst.Structs.Event.Event' to inspect.
    -> m ((Bool, Int32, Double, Double))
    -- ^ __Returns:__ TRUE if the button number and both coordinates could be extracted,
    --     otherwise FALSE.
navigationEventParseMouseButtonEvent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Bool, Int32, Double, Double)
navigationEventParseMouseButtonEvent Event
event = IO (Bool, Int32, Double, Double) -> m (Bool, Int32, Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32, Double, Double)
 -> m (Bool, Int32, Double, Double))
-> IO (Bool, Int32, Double, Double)
-> m (Bool, Int32, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Int32
button <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr CDouble
x <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
y <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> Ptr Int32 -> Ptr CDouble -> Ptr CDouble -> IO CInt
gst_navigation_event_parse_mouse_button_event Ptr Event
event' Ptr Int32
button Ptr CDouble
x Ptr CDouble
y
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
button' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
button
    CDouble
x' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
x
    let x'' :: Double
x'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x'
    CDouble
y' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
y
    let y'' :: Double
y'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
button
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
x
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
y
    (Bool, Int32, Double, Double) -> IO (Bool, Int32, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
button', Double
x'', Double
y'')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::event_parse_mouse_move_event
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstEvent to inspect."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Pointer to a gdouble to receive the x coordinate of the\n    mouse movement."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Pointer to a gdouble to receive the y coordinate of the\n    mouse movement."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_event_parse_mouse_move_event" gst_navigation_event_parse_mouse_move_event :: 
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CDouble ->                          -- x : TBasicType TDouble
    Ptr CDouble ->                          -- y : TBasicType TDouble
    IO CInt

-- | Inspect a t'GI.GstVideo.Interfaces.Navigation.Navigation' mouse movement event and extract the coordinates
-- of the event.
navigationEventParseMouseMoveEvent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Event.Event
    -- ^ /@event@/: A t'GI.Gst.Structs.Event.Event' to inspect.
    -> m ((Bool, Double, Double))
    -- ^ __Returns:__ TRUE if both coordinates could be extracted, otherwise FALSE.
navigationEventParseMouseMoveEvent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Bool, Double, Double)
navigationEventParseMouseMoveEvent Event
event = IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Double) -> m (Bool, Double, Double))
-> IO (Bool, Double, Double) -> m (Bool, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CDouble
x <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
y <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event -> Ptr CDouble -> Ptr CDouble -> IO CInt
gst_navigation_event_parse_mouse_move_event Ptr Event
event' Ptr CDouble
x Ptr CDouble
y
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
x' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
x
    let x'' :: Double
x'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x'
    CDouble
y' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
y
    let y'' :: Double
y'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
x
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
y
    (Bool, Double, Double) -> IO (Bool, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
x'', Double
y'')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::event_parse_mouse_scroll_event
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstEvent to inspect."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Pointer to a gdouble to receive the x coordinate of the\n    mouse movement."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Pointer to a gdouble to receive the y coordinate of the\n    mouse movement."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "delta_x"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Pointer to a gdouble to receive the delta_x coordinate of the\n    mouse movement."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "delta_y"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Pointer to a gdouble to receive the delta_y coordinate of the\n    mouse movement."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_event_parse_mouse_scroll_event" gst_navigation_event_parse_mouse_scroll_event :: 
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CDouble ->                          -- x : TBasicType TDouble
    Ptr CDouble ->                          -- y : TBasicType TDouble
    Ptr CDouble ->                          -- delta_x : TBasicType TDouble
    Ptr CDouble ->                          -- delta_y : TBasicType TDouble
    IO CInt

-- | Inspect a t'GI.GstVideo.Interfaces.Navigation.Navigation' mouse scroll event and extract the coordinates
-- of the event.
-- 
-- /Since: 1.18/
navigationEventParseMouseScrollEvent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Event.Event
    -- ^ /@event@/: A t'GI.Gst.Structs.Event.Event' to inspect.
    -> m ((Bool, Double, Double, Double, Double))
    -- ^ __Returns:__ TRUE if all coordinates could be extracted, otherwise FALSE.
navigationEventParseMouseScrollEvent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Bool, Double, Double, Double, Double)
navigationEventParseMouseScrollEvent Event
event = IO (Bool, Double, Double, Double, Double)
-> m (Bool, Double, Double, Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Double, Double, Double)
 -> m (Bool, Double, Double, Double, Double))
-> IO (Bool, Double, Double, Double, Double)
-> m (Bool, Double, Double, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CDouble
x <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
y <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
deltaX <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
deltaY <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Event
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> IO CInt
gst_navigation_event_parse_mouse_scroll_event Ptr Event
event' Ptr CDouble
x Ptr CDouble
y Ptr CDouble
deltaX Ptr CDouble
deltaY
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
x' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
x
    let x'' :: Double
x'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x'
    CDouble
y' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
y
    let y'' :: Double
y'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y'
    CDouble
deltaX' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
deltaX
    let deltaX'' :: Double
deltaX'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
deltaX'
    CDouble
deltaY' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
deltaY
    let deltaY'' :: Double
deltaY'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
deltaY'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
x
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
y
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
deltaX
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
deltaY
    (Bool, Double, Double, Double, Double)
-> IO (Bool, Double, Double, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
x'', Double
y'', Double
deltaX'', Double
deltaY'')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::message_get_type
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstMessage to inspect."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "NavigationMessageType" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_message_get_type" gst_navigation_message_get_type :: 
    Ptr Gst.Message.Message ->              -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    IO CUInt

-- | Check a bus message to see if it is a t'GI.GstVideo.Interfaces.Navigation.Navigation' event, and return
-- the t'GI.GstVideo.Enums.NavigationMessageType' identifying the type of the message if so.
navigationMessageGetType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Message.Message
    -- ^ /@message@/: A t'GI.Gst.Structs.Message.Message' to inspect.
    -> m GstVideo.Enums.NavigationMessageType
    -- ^ __Returns:__ The type of the t'GI.Gst.Structs.Message.Message', or
    -- @/GST_NAVIGATION_MESSAGE_INVALID/@ if the message is not a t'GI.GstVideo.Interfaces.Navigation.Navigation'
    -- notification.
navigationMessageGetType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Message -> m NavigationMessageType
navigationMessageGetType Message
message = IO NavigationMessageType -> m NavigationMessageType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NavigationMessageType -> m NavigationMessageType)
-> IO NavigationMessageType -> m NavigationMessageType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    CUInt
result <- Ptr Message -> IO CUInt
gst_navigation_message_get_type Ptr Message
message'
    let result' :: NavigationMessageType
result' = (Int -> NavigationMessageType
forall a. Enum a => Int -> a
toEnum (Int -> NavigationMessageType)
-> (CUInt -> Int) -> CUInt -> NavigationMessageType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    NavigationMessageType -> IO NavigationMessageType
forall (m :: * -> *) a. Monad m => a -> m a
return NavigationMessageType
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::message_new_angles_changed
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A #GstObject to set as source of the new message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cur_angle"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The currently selected angle."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_angles"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The number of viewing angles now available."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_message_new_angles_changed" gst_navigation_message_new_angles_changed :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Word32 ->                               -- cur_angle : TBasicType TUInt
    Word32 ->                               -- n_angles : TBasicType TUInt
    IO (Ptr Gst.Message.Message)

-- | Creates a new t'GI.GstVideo.Interfaces.Navigation.Navigation' message with type
-- @/GST_NAVIGATION_MESSAGE_ANGLES_CHANGED/@ for notifying an application
-- that the current angle, or current number of angles available in a
-- multiangle video has changed.
navigationMessageNewAnglesChanged ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    a
    -- ^ /@src@/: A t'GI.Gst.Objects.Object.Object' to set as source of the new message.
    -> Word32
    -- ^ /@curAngle@/: The currently selected angle.
    -> Word32
    -- ^ /@nAngles@/: The number of viewing angles now available.
    -> m Gst.Message.Message
    -- ^ __Returns:__ The new t'GI.Gst.Structs.Message.Message'.
navigationMessageNewAnglesChanged :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsObject a) =>
a -> Word32 -> Word32 -> m Message
navigationMessageNewAnglesChanged a
src Word32
curAngle Word32
nAngles = IO Message -> m Message
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Message -> m Message) -> IO Message -> m Message
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr Message
result <- Ptr Object -> Word32 -> Word32 -> IO (Ptr Message)
gst_navigation_message_new_angles_changed Ptr Object
src' Word32
curAngle Word32
nAngles
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"navigationMessageNewAnglesChanged" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Gst.Message.Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::message_new_commands_changed
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A #GstObject to set as source of the new message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_message_new_commands_changed" gst_navigation_message_new_commands_changed :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    IO (Ptr Gst.Message.Message)

-- | Creates a new t'GI.GstVideo.Interfaces.Navigation.Navigation' message with type
-- @/GST_NAVIGATION_MESSAGE_COMMANDS_CHANGED/@
navigationMessageNewCommandsChanged ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    a
    -- ^ /@src@/: A t'GI.Gst.Objects.Object.Object' to set as source of the new message.
    -> m Gst.Message.Message
    -- ^ __Returns:__ The new t'GI.Gst.Structs.Message.Message'.
navigationMessageNewCommandsChanged :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsObject a) =>
a -> m Message
navigationMessageNewCommandsChanged a
src = IO Message -> m Message
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Message -> m Message) -> IO Message -> m Message
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr Message
result <- Ptr Object -> IO (Ptr Message)
gst_navigation_message_new_commands_changed Ptr Object
src'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"navigationMessageNewCommandsChanged" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Gst.Message.Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::message_new_event
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A #GstObject to set as source of the new message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A navigation #GstEvent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_message_new_event" gst_navigation_message_new_event :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Event.Event ->                  -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO (Ptr Gst.Message.Message)

-- | Creates a new t'GI.GstVideo.Interfaces.Navigation.Navigation' message with type
-- @/GST_NAVIGATION_MESSAGE_EVENT/@.
-- 
-- /Since: 1.6/
navigationMessageNewEvent ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    a
    -- ^ /@src@/: A t'GI.Gst.Objects.Object.Object' to set as source of the new message.
    -> Gst.Event.Event
    -- ^ /@event@/: A navigation t'GI.Gst.Structs.Event.Event'
    -> m Gst.Message.Message
    -- ^ __Returns:__ The new t'GI.Gst.Structs.Message.Message'.
navigationMessageNewEvent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsObject a) =>
a -> Event -> m Message
navigationMessageNewEvent a
src Event
event = IO Message -> m Message
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Message -> m Message) -> IO Message -> m Message
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Message
result <- Ptr Object -> Ptr Event -> IO (Ptr Message)
gst_navigation_message_new_event Ptr Object
src' Ptr Event
event'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"navigationMessageNewEvent" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Gst.Message.Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::message_new_mouse_over
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A #GstObject to set as source of the new message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%TRUE if the mouse has entered a clickable area of the display.\n%FALSE if it over a non-clickable area."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_message_new_mouse_over" gst_navigation_message_new_mouse_over :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CInt ->                                 -- active : TBasicType TBoolean
    IO (Ptr Gst.Message.Message)

-- | Creates a new t'GI.GstVideo.Interfaces.Navigation.Navigation' message with type
-- @/GST_NAVIGATION_MESSAGE_MOUSE_OVER/@.
navigationMessageNewMouseOver ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    a
    -- ^ /@src@/: A t'GI.Gst.Objects.Object.Object' to set as source of the new message.
    -> Bool
    -- ^ /@active@/: 'P.True' if the mouse has entered a clickable area of the display.
    -- 'P.False' if it over a non-clickable area.
    -> m Gst.Message.Message
    -- ^ __Returns:__ The new t'GI.Gst.Structs.Message.Message'.
navigationMessageNewMouseOver :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsObject a) =>
a -> Bool -> m Message
navigationMessageNewMouseOver a
src Bool
active = IO Message -> m Message
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Message -> m Message) -> IO Message -> m Message
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    let active' :: CInt
active' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
active
    Ptr Message
result <- Ptr Object -> CInt -> IO (Ptr Message)
gst_navigation_message_new_mouse_over Ptr Object
src' CInt
active'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"navigationMessageNewMouseOver" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Gst.Message.Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::message_parse_angles_changed
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstMessage to inspect."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cur_angle"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A pointer to a #guint to receive the new\n    current angle number, or NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "n_angles"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A pointer to a #guint to receive the new angle\n    count, or NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_message_parse_angles_changed" gst_navigation_message_parse_angles_changed :: 
    Ptr Gst.Message.Message ->              -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr Word32 ->                           -- cur_angle : TBasicType TUInt
    Ptr Word32 ->                           -- n_angles : TBasicType TUInt
    IO CInt

-- | Parse a t'GI.GstVideo.Interfaces.Navigation.Navigation' message of type GST_NAVIGATION_MESSAGE_ANGLES_CHANGED
-- and extract the /@curAngle@/ and /@nAngles@/ parameters.
navigationMessageParseAnglesChanged ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Message.Message
    -- ^ /@message@/: A t'GI.Gst.Structs.Message.Message' to inspect.
    -> m ((Bool, Word32, Word32))
    -- ^ __Returns:__ 'P.True' if the message could be successfully parsed. 'P.False' if not.
navigationMessageParseAnglesChanged :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Message -> m (Bool, Word32, Word32)
navigationMessageParseAnglesChanged Message
message = IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32))
-> IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr Word32
curAngle <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
nAngles <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Message -> Ptr Word32 -> Ptr Word32 -> IO CInt
gst_navigation_message_parse_angles_changed Ptr Message
message' Ptr Word32
curAngle Ptr Word32
nAngles
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
curAngle' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
curAngle
    Word32
nAngles' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
nAngles
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
curAngle
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
nAngles
    (Bool, Word32, Word32) -> IO (Bool, Word32, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
curAngle', Word32
nAngles')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::message_parse_event
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstMessage to inspect."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TInterface Name { namespace = "Gst" , name = "Event" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a pointer to a #GstEvent to receive\n    the contained navigation event."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_message_parse_event" gst_navigation_message_parse_event :: 
    Ptr Gst.Message.Message ->              -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.Event.Event) ->            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO CInt

-- | Parse a t'GI.GstVideo.Interfaces.Navigation.Navigation' message of type @/GST_NAVIGATION_MESSAGE_EVENT/@
-- and extract contained t'GI.Gst.Structs.Event.Event'. The caller must unref the /@event@/ when done
-- with it.
-- 
-- /Since: 1.6/
navigationMessageParseEvent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Message.Message
    -- ^ /@message@/: A t'GI.Gst.Structs.Message.Message' to inspect.
    -> m ((Bool, Gst.Event.Event))
    -- ^ __Returns:__ 'P.True' if the message could be successfully parsed. 'P.False' if not.
navigationMessageParseEvent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Message -> m (Bool, Event)
navigationMessageParseEvent Message
message = IO (Bool, Event) -> m (Bool, Event)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Event) -> m (Bool, Event))
-> IO (Bool, Event) -> m (Bool, Event)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Event)
event <- IO (Ptr (Ptr Event))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Event.Event))
    CInt
result <- Ptr Message -> Ptr (Ptr Event) -> IO CInt
gst_navigation_message_parse_event Ptr Message
message' Ptr (Ptr Event)
event
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Event
event' <- Ptr (Ptr Event) -> IO (Ptr Event)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Event)
event
    Event
event'' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Gst.Event.Event) Ptr Event
event'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr Event) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Event)
event
    (Bool, Event) -> IO (Bool, Event)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Event
event'')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::message_parse_mouse_over
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstMessage to inspect."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A pointer to a gboolean to receive the\n    active/inactive state, or NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_message_parse_mouse_over" gst_navigation_message_parse_mouse_over :: 
    Ptr Gst.Message.Message ->              -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr CInt ->                             -- active : TBasicType TBoolean
    IO CInt

-- | Parse a t'GI.GstVideo.Interfaces.Navigation.Navigation' message of type @/GST_NAVIGATION_MESSAGE_MOUSE_OVER/@
-- and extract the active\/inactive flag. If the mouse over event is marked
-- active, it indicates that the mouse is over a clickable area.
navigationMessageParseMouseOver ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Message.Message
    -- ^ /@message@/: A t'GI.Gst.Structs.Message.Message' to inspect.
    -> m ((Bool, Bool))
    -- ^ __Returns:__ 'P.True' if the message could be successfully parsed. 'P.False' if not.
navigationMessageParseMouseOver :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Message -> m (Bool, Bool)
navigationMessageParseMouseOver Message
message = IO (Bool, Bool) -> m (Bool, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Bool) -> m (Bool, Bool))
-> IO (Bool, Bool) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr CInt
active <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    CInt
result <- Ptr Message -> Ptr CInt -> IO CInt
gst_navigation_message_parse_mouse_over Ptr Message
message' Ptr CInt
active
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CInt
active' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
active
    let active'' :: Bool
active'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
active'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
active
    (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Bool
active'')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::query_get_type
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The query to inspect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "NavigationQueryType" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_query_get_type" gst_navigation_query_get_type :: 
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    IO CUInt

-- | Inspect a t'GI.Gst.Structs.Query.Query' and return the t'GI.GstVideo.Enums.NavigationQueryType' associated with
-- it if it is a t'GI.GstVideo.Interfaces.Navigation.Navigation' query.
navigationQueryGetType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Query.Query
    -- ^ /@query@/: The query to inspect
    -> m GstVideo.Enums.NavigationQueryType
    -- ^ __Returns:__ The t'GI.GstVideo.Enums.NavigationQueryType' of the query, or
    -- @/GST_NAVIGATION_QUERY_INVALID/@
navigationQueryGetType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Query -> m NavigationQueryType
navigationQueryGetType Query
query = IO NavigationQueryType -> m NavigationQueryType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NavigationQueryType -> m NavigationQueryType)
-> IO NavigationQueryType -> m NavigationQueryType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    CUInt
result <- Ptr Query -> IO CUInt
gst_navigation_query_get_type Ptr Query
query'
    let result' :: NavigationQueryType
result' = (Int -> NavigationQueryType
forall a. Enum a => Int -> a
toEnum (Int -> NavigationQueryType)
-> (CUInt -> Int) -> CUInt -> NavigationQueryType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    NavigationQueryType -> IO NavigationQueryType
forall (m :: * -> *) a. Monad m => a -> m a
return NavigationQueryType
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::query_new_angles
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_query_new_angles" gst_navigation_query_new_angles :: 
    IO (Ptr Gst.Query.Query)

-- | Create a new t'GI.GstVideo.Interfaces.Navigation.Navigation' angles query. When executed, it will
-- query the pipeline for the set of currently available angles, which may be
-- greater than one in a multiangle video.
navigationQueryNewAngles ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Gst.Query.Query
    -- ^ __Returns:__ The new query.
navigationQueryNewAngles :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Query
navigationQueryNewAngles  = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
result <- IO (Ptr Query)
gst_navigation_query_new_angles
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"navigationQueryNewAngles" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Gst.Query.Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::query_new_commands
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Query" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_query_new_commands" gst_navigation_query_new_commands :: 
    IO (Ptr Gst.Query.Query)

-- | Create a new t'GI.GstVideo.Interfaces.Navigation.Navigation' commands query. When executed, it will
-- query the pipeline for the set of currently available commands.
navigationQueryNewCommands ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Gst.Query.Query
    -- ^ __Returns:__ The new query.
navigationQueryNewCommands :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Query
navigationQueryNewCommands  = IO Query -> m Query
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Query -> m Query) -> IO Query -> m Query
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
result <- IO (Ptr Query)
gst_navigation_query_new_commands
    Text -> Ptr Query -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"navigationQueryNewCommands" Ptr Query
result
    Query
result' <- ((ManagedPtr Query -> Query) -> Ptr Query -> IO Query
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Query -> Query
Gst.Query.Query) Ptr Query
result
    Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return Query
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::query_parse_angles
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cur_angle"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Pointer to a #guint into which to store the\n    currently selected angle value from the query, or NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "n_angles"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Pointer to a #guint into which to store the\n    number of angles value from the query, or NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_query_parse_angles" gst_navigation_query_parse_angles :: 
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr Word32 ->                           -- cur_angle : TBasicType TUInt
    Ptr Word32 ->                           -- n_angles : TBasicType TUInt
    IO CInt

-- | Parse the current angle number in the t'GI.GstVideo.Interfaces.Navigation.Navigation' angles /@query@/ into the
-- @/guint/@ pointed to by the /@curAngle@/ variable, and the number of available
-- angles into the @/guint/@ pointed to by the /@nAngles@/ variable.
navigationQueryParseAngles ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Query.Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m ((Bool, Word32, Word32))
    -- ^ __Returns:__ 'P.True' if the query could be successfully parsed. 'P.False' if not.
navigationQueryParseAngles :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Query -> m (Bool, Word32, Word32)
navigationQueryParseAngles Query
query = IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32))
-> IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Word32
curAngle <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
nAngles <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Query -> Ptr Word32 -> Ptr Word32 -> IO CInt
gst_navigation_query_parse_angles Ptr Query
query' Ptr Word32
curAngle Ptr Word32
nAngles
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
curAngle' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
curAngle
    Word32
nAngles' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
nAngles
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
curAngle
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
nAngles
    (Bool, Word32, Word32) -> IO (Bool, Word32, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
curAngle', Word32
nAngles')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::query_parse_commands_length
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_cmds"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of commands in this query."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_query_parse_commands_length" gst_navigation_query_parse_commands_length :: 
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Ptr Word32 ->                           -- n_cmds : TBasicType TUInt
    IO CInt

-- | Parse the number of commands in the t'GI.GstVideo.Interfaces.Navigation.Navigation' commands /@query@/.
navigationQueryParseCommandsLength ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Query.Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' if the query could be successfully parsed. 'P.False' if not.
navigationQueryParseCommandsLength :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Query -> m (Bool, Word32)
navigationQueryParseCommandsLength Query
query = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Word32
nCmds <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Query -> Ptr Word32 -> IO CInt
gst_navigation_query_parse_commands_length Ptr Query
query' Ptr Word32
nCmds
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
nCmds' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
nCmds
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
nCmds
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
nCmds')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::query_parse_commands_nth
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nth"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the nth command to retrieve."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cmd"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "NavigationCommand" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to store the nth command into."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_query_parse_commands_nth" gst_navigation_query_parse_commands_nth :: 
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- nth : TBasicType TUInt
    Ptr CUInt ->                            -- cmd : TInterface (Name {namespace = "GstVideo", name = "NavigationCommand"})
    IO CInt

-- | Parse the t'GI.GstVideo.Interfaces.Navigation.Navigation' command query and retrieve the /@nth@/ command from
-- it into /@cmd@/. If the list contains less elements than /@nth@/, /@cmd@/ will be
-- set to @/GST_NAVIGATION_COMMAND_INVALID/@.
navigationQueryParseCommandsNth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Query.Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> Word32
    -- ^ /@nth@/: the nth command to retrieve.
    -> m ((Bool, GstVideo.Enums.NavigationCommand))
    -- ^ __Returns:__ 'P.True' if the query could be successfully parsed. 'P.False' if not.
navigationQueryParseCommandsNth :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Query -> Word32 -> m (Bool, NavigationCommand)
navigationQueryParseCommandsNth Query
query Word32
nth = IO (Bool, NavigationCommand) -> m (Bool, NavigationCommand)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, NavigationCommand) -> m (Bool, NavigationCommand))
-> IO (Bool, NavigationCommand) -> m (Bool, NavigationCommand)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr CUInt
cmd <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr Query -> Word32 -> Ptr CUInt -> IO CInt
gst_navigation_query_parse_commands_nth Ptr Query
query' Word32
nth Ptr CUInt
cmd
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CUInt
cmd' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
cmd
    let cmd'' :: NavigationCommand
cmd'' = (Int -> NavigationCommand
forall a. Enum a => Int -> a
toEnum (Int -> NavigationCommand)
-> (CUInt -> Int) -> CUInt -> NavigationCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
cmd'
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
cmd
    (Bool, NavigationCommand) -> IO (Bool, NavigationCommand)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', NavigationCommand
cmd'')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::query_set_angles
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cur_angle"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the current viewing angle to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_angles"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of viewing angles to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_query_set_angles" gst_navigation_query_set_angles :: 
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Word32 ->                               -- cur_angle : TBasicType TUInt
    Word32 ->                               -- n_angles : TBasicType TUInt
    IO ()

-- | Set the t'GI.GstVideo.Interfaces.Navigation.Navigation' angles query result field in /@query@/.
navigationQuerySetAngles ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Query.Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> Word32
    -- ^ /@curAngle@/: the current viewing angle to set.
    -> Word32
    -- ^ /@nAngles@/: the number of viewing angles to set.
    -> m ()
navigationQuerySetAngles :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Query -> Word32 -> Word32 -> m ()
navigationQuerySetAngles Query
query Word32
curAngle Word32
nAngles = 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 Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    Ptr Query -> Word32 -> Word32 -> IO ()
gst_navigation_query_set_angles Ptr Query
query' Word32
curAngle Word32
nAngles
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Navigation::query_set_commandsv
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "query"
--           , argType = TInterface Name { namespace = "Gst" , name = "Query" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstQuery" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_cmds"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of commands to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cmds"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface
--                    Name { namespace = "GstVideo" , name = "NavigationCommand" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An array containing @n_cmds\n    @GstNavigationCommand values."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_cmds"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of commands to set."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_navigation_query_set_commandsv" gst_navigation_query_set_commandsv :: 
    Ptr Gst.Query.Query ->                  -- query : TInterface (Name {namespace = "Gst", name = "Query"})
    Int32 ->                                -- n_cmds : TBasicType TInt
    Ptr CUInt ->                            -- cmds : TCArray False (-1) 1 (TInterface (Name {namespace = "GstVideo", name = "NavigationCommand"}))
    IO ()

-- | Set the t'GI.GstVideo.Interfaces.Navigation.Navigation' command query result fields in /@query@/. The number
-- of commands passed must be equal to /@nCommands@/.
navigationQuerySetCommandsv ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Query.Query
    -- ^ /@query@/: a t'GI.Gst.Structs.Query.Query'
    -> [GstVideo.Enums.NavigationCommand]
    -- ^ /@cmds@/: An array containing /@nCmds@/
    --     /@gstNavigationCommand@/ values.
    -> m ()
navigationQuerySetCommandsv :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Query -> [NavigationCommand] -> m ()
navigationQuerySetCommandsv Query
query [NavigationCommand]
cmds = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nCmds :: Int32
nCmds = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [NavigationCommand] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [NavigationCommand]
cmds
    Ptr Query
query' <- Query -> IO (Ptr Query)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Query
query
    let cmds' :: [CUInt]
cmds' = (NavigationCommand -> CUInt) -> [NavigationCommand] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (NavigationCommand -> Int) -> NavigationCommand -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavigationCommand -> Int
forall a. Enum a => a -> Int
fromEnum) [NavigationCommand]
cmds
    Ptr CUInt
cmds'' <- [CUInt] -> IO (Ptr CUInt)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [CUInt]
cmds'
    Ptr Query -> Int32 -> Ptr CUInt -> IO ()
gst_navigation_query_set_commandsv Ptr Query
query' Int32
nCmds Ptr CUInt
cmds''
    Query -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Query
query
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
cmds''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Navigation = NavigationSignalList
type NavigationSignalList = ('[ ] :: [(Symbol, *)])

#endif