{-# 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                                 ,
    noMovie                                 ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveMovieMethod                      ,
#endif


-- ** getFilename #method:getFilename#

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


-- ** getPlayMode #method:getPlayMode#

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


-- ** 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

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

-- | Memory-managed wrapper type.
newtype Movie = Movie (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)
foreign import ccall "poppler_movie_get_type"
    c_poppler_movie_get_type :: IO GType

instance GObject Movie where
    gobjectType :: IO GType
gobjectType = IO GType
c_poppler_movie_get_type
    

-- | Convert 'Movie' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Movie where
    toGValue :: Movie -> IO GValue
toGValue o :: Movie
o = do
        GType
gtype <- IO GType
c_poppler_movie_get_type
        Movie -> (Ptr Movie -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Movie
o (GType -> (GValue -> Ptr Movie -> IO ()) -> Ptr Movie -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Movie -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Movie
fromGValue gv :: GValue
gv = do
        Ptr Movie
ptr <- GValue -> IO (Ptr Movie)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Movie)
        (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
        
    

-- | Type class for types which can be safely cast to `Movie`, for instance with `toMovie`.
class (GObject o, O.IsDescendantOf Movie o) => IsMovie o
instance (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 :: (MonadIO m, IsMovie o) => o -> m Movie
toMovie :: o -> m Movie
toMovie = IO Movie -> m Movie
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Movie -> Movie
Movie

-- | A convenience alias for `Nothing` :: `Maybe` `Movie`.
noMovie :: Maybe Movie
noMovie :: Maybe Movie
noMovie = Maybe Movie
forall a. Maybe a
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 "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 "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMovieMethod "getFilename" o = MovieGetFilenameMethodInfo
    ResolveMovieMethod "getPlayMode" o = MovieGetPlayModeMethodInfo
    ResolveMovieMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMovieMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    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.MethodInfo 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

#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_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 :: a -> m Text
movieGetFilename popplerMovie :: 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 "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.MethodInfo MovieGetFilenameMethodInfo a signature where
    overloadedMethod = 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 :: a -> m MoviePlayMode
movieGetPlayMode popplerMovie :: 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.MethodInfo MovieGetPlayModeMethodInfo a signature where
    overloadedMethod = movieGetPlayMode

#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 :: a -> m Bool
movieNeedPoster popplerMovie :: 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
/= 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.MethodInfo MovieNeedPosterMethodInfo a signature where
    overloadedMethod = 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 :: a -> m Bool
movieShowControls popplerMovie :: 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
/= 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.MethodInfo MovieShowControlsMethodInfo a signature where
    overloadedMethod = movieShowControls

#endif