{-# LANGUAGE TypeApplications #-}


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

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

module GI.Poppler.Objects.Movie
    ( 

-- * Exported types
    Movie(..)                               ,
    IsMovie                                 ,
    toMovie                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isSynchronous]("GI.Poppler.Objects.Movie#g:method:isSynchronous"), [needPoster]("GI.Poppler.Objects.Movie#g:method:needPoster"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [showControls]("GI.Poppler.Objects.Movie#g:method:showControls"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAspect]("GI.Poppler.Objects.Movie#g:method:getAspect"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDuration]("GI.Poppler.Objects.Movie#g:method:getDuration"), [getFilename]("GI.Poppler.Objects.Movie#g:method:getFilename"), [getPlayMode]("GI.Poppler.Objects.Movie#g:method:getPlayMode"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRate]("GI.Poppler.Objects.Movie#g:method:getRate"), [getRotationAngle]("GI.Poppler.Objects.Movie#g:method:getRotationAngle"), [getStart]("GI.Poppler.Objects.Movie#g:method:getStart"), [getVolume]("GI.Poppler.Objects.Movie#g:method:getVolume").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveMovieMethod                      ,
#endif

-- ** getAspect #method:getAspect#

#if defined(ENABLE_OVERLOADING)
    MovieGetAspectMethodInfo                ,
#endif
    movieGetAspect                          ,


-- ** getDuration #method:getDuration#

#if defined(ENABLE_OVERLOADING)
    MovieGetDurationMethodInfo              ,
#endif
    movieGetDuration                        ,


-- ** getFilename #method:getFilename#

#if defined(ENABLE_OVERLOADING)
    MovieGetFilenameMethodInfo              ,
#endif
    movieGetFilename                        ,


-- ** getPlayMode #method:getPlayMode#

#if defined(ENABLE_OVERLOADING)
    MovieGetPlayModeMethodInfo              ,
#endif
    movieGetPlayMode                        ,


-- ** getRate #method:getRate#

#if defined(ENABLE_OVERLOADING)
    MovieGetRateMethodInfo                  ,
#endif
    movieGetRate                            ,


-- ** getRotationAngle #method:getRotationAngle#

#if defined(ENABLE_OVERLOADING)
    MovieGetRotationAngleMethodInfo         ,
#endif
    movieGetRotationAngle                   ,


-- ** getStart #method:getStart#

#if defined(ENABLE_OVERLOADING)
    MovieGetStartMethodInfo                 ,
#endif
    movieGetStart                           ,


-- ** getVolume #method:getVolume#

#if defined(ENABLE_OVERLOADING)
    MovieGetVolumeMethodInfo                ,
#endif
    movieGetVolume                          ,


-- ** isSynchronous #method:isSynchronous#

#if defined(ENABLE_OVERLOADING)
    MovieIsSynchronousMethodInfo            ,
#endif
    movieIsSynchronous                      ,


-- ** needPoster #method:needPoster#

#if defined(ENABLE_OVERLOADING)
    MovieNeedPosterMethodInfo               ,
#endif
    movieNeedPoster                         ,


-- ** showControls #method:showControls#

#if defined(ENABLE_OVERLOADING)
    MovieShowControlsMethodInfo             ,
#endif
    movieShowControls                       ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums

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

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

foreign import ccall "poppler_movie_get_type"
    c_poppler_movie_get_type :: IO B.Types.GType

instance B.Types.TypedObject Movie where
    glibType :: IO GType
glibType = IO GType
c_poppler_movie_get_type

instance B.Types.GObject Movie

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

instance O.HasParentTypes Movie
type instance O.ParentTypes Movie = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveMovieMethod (t :: Symbol) (o :: *) :: * where
    ResolveMovieMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMovieMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMovieMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMovieMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMovieMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMovieMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMovieMethod "isSynchronous" o = MovieIsSynchronousMethodInfo
    ResolveMovieMethod "needPoster" o = MovieNeedPosterMethodInfo
    ResolveMovieMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMovieMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMovieMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMovieMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMovieMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMovieMethod "showControls" o = MovieShowControlsMethodInfo
    ResolveMovieMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMovieMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMovieMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMovieMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMovieMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMovieMethod "getAspect" o = MovieGetAspectMethodInfo
    ResolveMovieMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMovieMethod "getDuration" o = MovieGetDurationMethodInfo
    ResolveMovieMethod "getFilename" o = MovieGetFilenameMethodInfo
    ResolveMovieMethod "getPlayMode" o = MovieGetPlayModeMethodInfo
    ResolveMovieMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMovieMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMovieMethod "getRate" o = MovieGetRateMethodInfo
    ResolveMovieMethod "getRotationAngle" o = MovieGetRotationAngleMethodInfo
    ResolveMovieMethod "getStart" o = MovieGetStartMethodInfo
    ResolveMovieMethod "getVolume" o = MovieGetVolumeMethodInfo
    ResolveMovieMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMovieMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMovieMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMovieMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Movie
type instance O.AttributeList Movie = MovieAttributeList
type MovieAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Movie = MovieSignalList
type MovieSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Movie::get_aspect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_movie"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Movie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMovie" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "width of the movie's bounding box"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "height of the movie's bounding box"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_movie_get_aspect" poppler_movie_get_aspect :: 
    Ptr Movie ->                            -- poppler_movie : TInterface (Name {namespace = "Poppler", name = "Movie"})
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    IO ()

-- | Returns the dimensions of the movie\'s bounding box (in pixels).
-- The respective PDF movie dictionary entry is optional; if missing,
-- -1x-1 will be returned.
-- 
-- /Since: 0.89/
movieGetAspect ::
    (B.CallStack.HasCallStack, MonadIO m, IsMovie a) =>
    a
    -- ^ /@popplerMovie@/: a t'GI.Poppler.Objects.Movie.Movie'
    -> Int32
    -- ^ /@width@/: width of the movie\'s bounding box
    -> Int32
    -- ^ /@height@/: height of the movie\'s bounding box
    -> m ()
movieGetAspect :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMovie a) =>
a -> Int32 -> Int32 -> m ()
movieGetAspect a
popplerMovie Int32
width Int32
height = 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 Movie
popplerMovie' <- a -> IO (Ptr Movie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMovie
    Ptr Movie -> Int32 -> Int32 -> IO ()
poppler_movie_get_aspect Ptr Movie
popplerMovie' Int32
width Int32
height
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMovie
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MovieGetAspectMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsMovie a) => O.OverloadedMethod MovieGetAspectMethodInfo a signature where
    overloadedMethod = movieGetAspect

instance O.OverloadedMethodInfo MovieGetAspectMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Movie.movieGetAspect",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Movie.html#v:movieGetAspect"
        }


#endif

-- method Movie::get_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_movie"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Movie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMovie" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_movie_get_duration" poppler_movie_get_duration :: 
    Ptr Movie ->                            -- poppler_movie : TInterface (Name {namespace = "Poppler", name = "Movie"})
    IO Word64

-- | Returns the duration of the movie playback
-- 
-- /Since: 0.80/
movieGetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsMovie a) =>
    a
    -- ^ /@popplerMovie@/: a t'GI.Poppler.Objects.Movie.Movie'
    -> m Word64
    -- ^ __Returns:__ the duration of the movie playback (in ns)
movieGetDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMovie a) =>
a -> m Word64
movieGetDuration a
popplerMovie = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Movie
popplerMovie' <- a -> IO (Ptr Movie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMovie
    Word64
result <- Ptr Movie -> IO Word64
poppler_movie_get_duration Ptr Movie
popplerMovie'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMovie
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data MovieGetDurationMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsMovie a) => O.OverloadedMethod MovieGetDurationMethodInfo a signature where
    overloadedMethod = movieGetDuration

instance O.OverloadedMethodInfo MovieGetDurationMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Movie.movieGetDuration",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Movie.html#v:movieGetDuration"
        }


#endif

-- method Movie::get_filename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_movie"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Movie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMovie" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_movie_get_filename" poppler_movie_get_filename :: 
    Ptr Movie ->                            -- poppler_movie : TInterface (Name {namespace = "Poppler", name = "Movie"})
    IO CString

-- | Returns the local filename identifying a self-describing movie file
-- 
-- /Since: 0.14/
movieGetFilename ::
    (B.CallStack.HasCallStack, MonadIO m, IsMovie a) =>
    a
    -- ^ /@popplerMovie@/: a t'GI.Poppler.Objects.Movie.Movie'
    -> m T.Text
    -- ^ __Returns:__ a local filename, return value is owned by t'GI.Poppler.Objects.Movie.Movie' and
    --               should not be freed
movieGetFilename :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMovie a) =>
a -> m Text
movieGetFilename a
popplerMovie = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Movie
popplerMovie' <- a -> IO (Ptr Movie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMovie
    CString
result <- Ptr Movie -> IO CString
poppler_movie_get_filename Ptr Movie
popplerMovie'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"movieGetFilename" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMovie
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MovieGetFilenameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsMovie a) => O.OverloadedMethod MovieGetFilenameMethodInfo a signature where
    overloadedMethod = movieGetFilename

instance O.OverloadedMethodInfo MovieGetFilenameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Movie.movieGetFilename",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Movie.html#v:movieGetFilename"
        }


#endif

-- method Movie::get_play_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_movie"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Movie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMovie" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Poppler" , name = "MoviePlayMode" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_movie_get_play_mode" poppler_movie_get_play_mode :: 
    Ptr Movie ->                            -- poppler_movie : TInterface (Name {namespace = "Poppler", name = "Movie"})
    IO CUInt

-- | Returns the play mode of /@popplerMovie@/.
-- 
-- /Since: 0.54/
movieGetPlayMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsMovie a) =>
    a
    -- ^ /@popplerMovie@/: a t'GI.Poppler.Objects.Movie.Movie'
    -> m Poppler.Enums.MoviePlayMode
    -- ^ __Returns:__ a t'GI.Poppler.Enums.MoviePlayMode'.
movieGetPlayMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMovie a) =>
a -> m MoviePlayMode
movieGetPlayMode a
popplerMovie = IO MoviePlayMode -> m MoviePlayMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MoviePlayMode -> m MoviePlayMode)
-> IO MoviePlayMode -> m MoviePlayMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr Movie
popplerMovie' <- a -> IO (Ptr Movie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMovie
    CUInt
result <- Ptr Movie -> IO CUInt
poppler_movie_get_play_mode Ptr Movie
popplerMovie'
    let result' :: MoviePlayMode
result' = (Int -> MoviePlayMode
forall a. Enum a => Int -> a
toEnum (Int -> MoviePlayMode) -> (CUInt -> Int) -> CUInt -> MoviePlayMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMovie
    MoviePlayMode -> IO MoviePlayMode
forall (m :: * -> *) a. Monad m => a -> m a
return MoviePlayMode
result'

#if defined(ENABLE_OVERLOADING)
data MovieGetPlayModeMethodInfo
instance (signature ~ (m Poppler.Enums.MoviePlayMode), MonadIO m, IsMovie a) => O.OverloadedMethod MovieGetPlayModeMethodInfo a signature where
    overloadedMethod = movieGetPlayMode

instance O.OverloadedMethodInfo MovieGetPlayModeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Movie.movieGetPlayMode",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Movie.html#v:movieGetPlayMode"
        }


#endif

-- method Movie::get_rate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_movie"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Movie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMovie" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_movie_get_rate" poppler_movie_get_rate :: 
    Ptr Movie ->                            -- poppler_movie : TInterface (Name {namespace = "Poppler", name = "Movie"})
    IO CDouble

-- | Returns the relative speed of the movie
-- 
-- /Since: 0.80/
movieGetRate ::
    (B.CallStack.HasCallStack, MonadIO m, IsMovie a) =>
    a
    -- ^ /@popplerMovie@/: a t'GI.Poppler.Objects.Movie.Movie'
    -> m Double
    -- ^ __Returns:__ the relative speed of the movie (1 means no change)
movieGetRate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMovie a) =>
a -> m Double
movieGetRate a
popplerMovie = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Movie
popplerMovie' <- a -> IO (Ptr Movie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMovie
    CDouble
result <- Ptr Movie -> IO CDouble
poppler_movie_get_rate Ptr Movie
popplerMovie'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMovie
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data MovieGetRateMethodInfo
instance (signature ~ (m Double), MonadIO m, IsMovie a) => O.OverloadedMethod MovieGetRateMethodInfo a signature where
    overloadedMethod = movieGetRate

instance O.OverloadedMethodInfo MovieGetRateMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Movie.movieGetRate",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Movie.html#v:movieGetRate"
        }


#endif

-- method Movie::get_rotation_angle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_movie"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Movie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMovie" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt16)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_movie_get_rotation_angle" poppler_movie_get_rotation_angle :: 
    Ptr Movie ->                            -- poppler_movie : TInterface (Name {namespace = "Poppler", name = "Movie"})
    IO Word16

-- | Returns the rotation angle
-- 
-- /Since: 0.80/
movieGetRotationAngle ::
    (B.CallStack.HasCallStack, MonadIO m, IsMovie a) =>
    a
    -- ^ /@popplerMovie@/: a t'GI.Poppler.Objects.Movie.Movie'
    -> m Word16
    -- ^ __Returns:__ the number of degrees the movie should be rotated (positive,
    -- multiples of 90: 0, 90, 180, 270)
movieGetRotationAngle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMovie a) =>
a -> m Word16
movieGetRotationAngle a
popplerMovie = IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    Ptr Movie
popplerMovie' <- a -> IO (Ptr Movie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMovie
    Word16
result <- Ptr Movie -> IO Word16
poppler_movie_get_rotation_angle Ptr Movie
popplerMovie'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMovie
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data MovieGetRotationAngleMethodInfo
instance (signature ~ (m Word16), MonadIO m, IsMovie a) => O.OverloadedMethod MovieGetRotationAngleMethodInfo a signature where
    overloadedMethod = movieGetRotationAngle

instance O.OverloadedMethodInfo MovieGetRotationAngleMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Movie.movieGetRotationAngle",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Movie.html#v:movieGetRotationAngle"
        }


#endif

-- method Movie::get_start
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_movie"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Movie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMovie" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_movie_get_start" poppler_movie_get_start :: 
    Ptr Movie ->                            -- poppler_movie : TInterface (Name {namespace = "Poppler", name = "Movie"})
    IO Word64

-- | Returns the start position of the movie playback
-- 
-- /Since: 0.80/
movieGetStart ::
    (B.CallStack.HasCallStack, MonadIO m, IsMovie a) =>
    a
    -- ^ /@popplerMovie@/: a t'GI.Poppler.Objects.Movie.Movie'
    -> m Word64
    -- ^ __Returns:__ the start position of the movie playback (in ns)
movieGetStart :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMovie a) =>
a -> m Word64
movieGetStart a
popplerMovie = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Movie
popplerMovie' <- a -> IO (Ptr Movie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMovie
    Word64
result <- Ptr Movie -> IO Word64
poppler_movie_get_start Ptr Movie
popplerMovie'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMovie
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data MovieGetStartMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsMovie a) => O.OverloadedMethod MovieGetStartMethodInfo a signature where
    overloadedMethod = movieGetStart

instance O.OverloadedMethodInfo MovieGetStartMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Movie.movieGetStart",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Movie.html#v:movieGetStart"
        }


#endif

-- method Movie::get_volume
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_movie"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Movie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMovie" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_movie_get_volume" poppler_movie_get_volume :: 
    Ptr Movie ->                            -- poppler_movie : TInterface (Name {namespace = "Poppler", name = "Movie"})
    IO CDouble

-- | Returns the playback audio volume
-- 
-- /Since: 0.80/
movieGetVolume ::
    (B.CallStack.HasCallStack, MonadIO m, IsMovie a) =>
    a
    -- ^ /@popplerMovie@/: a t'GI.Poppler.Objects.Movie.Movie'
    -> m Double
    -- ^ __Returns:__ volume setting for the movie (0.0 - 1.0)
movieGetVolume :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMovie a) =>
a -> m Double
movieGetVolume a
popplerMovie = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Movie
popplerMovie' <- a -> IO (Ptr Movie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMovie
    CDouble
result <- Ptr Movie -> IO CDouble
poppler_movie_get_volume Ptr Movie
popplerMovie'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMovie
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data MovieGetVolumeMethodInfo
instance (signature ~ (m Double), MonadIO m, IsMovie a) => O.OverloadedMethod MovieGetVolumeMethodInfo a signature where
    overloadedMethod = movieGetVolume

instance O.OverloadedMethodInfo MovieGetVolumeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Movie.movieGetVolume",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Movie.html#v:movieGetVolume"
        }


#endif

-- method Movie::is_synchronous
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_movie"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Movie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMovie" , 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 "poppler_movie_is_synchronous" poppler_movie_is_synchronous :: 
    Ptr Movie ->                            -- poppler_movie : TInterface (Name {namespace = "Poppler", name = "Movie"})
    IO CInt

-- | Returns whether the user must wait for the movie to be finished before
-- the PDF viewer accepts any interactive action
-- 
-- /Since: 0.80/
movieIsSynchronous ::
    (B.CallStack.HasCallStack, MonadIO m, IsMovie a) =>
    a
    -- ^ /@popplerMovie@/: a t'GI.Poppler.Objects.Movie.Movie'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if yes, 'P.False' otherwise
movieIsSynchronous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMovie a) =>
a -> m Bool
movieIsSynchronous a
popplerMovie = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Movie
popplerMovie' <- a -> IO (Ptr Movie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMovie
    CInt
result <- Ptr Movie -> IO CInt
poppler_movie_is_synchronous Ptr Movie
popplerMovie'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMovie
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MovieIsSynchronousMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMovie a) => O.OverloadedMethod MovieIsSynchronousMethodInfo a signature where
    overloadedMethod = movieIsSynchronous

instance O.OverloadedMethodInfo MovieIsSynchronousMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Movie.movieIsSynchronous",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Movie.html#v:movieIsSynchronous"
        }


#endif

-- method Movie::need_poster
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_movie"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Movie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMovie" , 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 "poppler_movie_need_poster" poppler_movie_need_poster :: 
    Ptr Movie ->                            -- poppler_movie : TInterface (Name {namespace = "Poppler", name = "Movie"})
    IO CInt

-- | Returns whether a poster image representing the Movie
-- shall be displayed. The poster image must be retrieved
-- from the movie file.
-- 
-- /Since: 0.14/
movieNeedPoster ::
    (B.CallStack.HasCallStack, MonadIO m, IsMovie a) =>
    a
    -- ^ /@popplerMovie@/: a t'GI.Poppler.Objects.Movie.Movie'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if move needs a poster image, 'P.False' otherwise
movieNeedPoster :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMovie a) =>
a -> m Bool
movieNeedPoster a
popplerMovie = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Movie
popplerMovie' <- a -> IO (Ptr Movie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMovie
    CInt
result <- Ptr Movie -> IO CInt
poppler_movie_need_poster Ptr Movie
popplerMovie'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMovie
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MovieNeedPosterMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMovie a) => O.OverloadedMethod MovieNeedPosterMethodInfo a signature where
    overloadedMethod = movieNeedPoster

instance O.OverloadedMethodInfo MovieNeedPosterMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Movie.movieNeedPoster",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Movie.html#v:movieNeedPoster"
        }


#endif

-- method Movie::show_controls
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_movie"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Movie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerMovie" , 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 "poppler_movie_show_controls" poppler_movie_show_controls :: 
    Ptr Movie ->                            -- poppler_movie : TInterface (Name {namespace = "Poppler", name = "Movie"})
    IO CInt

-- | Returns whether to display a movie controller bar while playing the movie
-- 
-- /Since: 0.14/
movieShowControls ::
    (B.CallStack.HasCallStack, MonadIO m, IsMovie a) =>
    a
    -- ^ /@popplerMovie@/: a t'GI.Poppler.Objects.Movie.Movie'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if controller bar should be displayed, 'P.False' otherwise
movieShowControls :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMovie a) =>
a -> m Bool
movieShowControls a
popplerMovie = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Movie
popplerMovie' <- a -> IO (Ptr Movie)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerMovie
    CInt
result <- Ptr Movie -> IO CInt
poppler_movie_show_controls Ptr Movie
popplerMovie'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerMovie
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MovieShowControlsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMovie a) => O.OverloadedMethod MovieShowControlsMethodInfo a signature where
    overloadedMethod = movieShowControls

instance O.OverloadedMethodInfo MovieShowControlsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Movie.movieShowControls",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Movie.html#v:movieShowControls"
        }


#endif