module Media.Streaming.GStreamer.Controller.Controller (
Controller,
ControllerClass,
) where
import Control.Monad (liftM)
import Media.Streaming.GStreamer.Controller.Types
import System.Glib.GList
import System.Glib.GObject
import System.Glib.FFI
import System.Glib.UTFString
controllerInit :: IO Bool
controllerInit =
liftM toBool $ gst_controller_init nullPtr nullPtr
controllerNew :: GObjectClass gObjectT
=> gObjectT
-> [String]
-> IO Controller
controllerNew object properties =
withMany withUTFString properties $ \cProperties ->
do cPropertiesGList <- toGList cProperties
cController <- (\(GObject arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gst_controller_new_list argPtr1 arg2) (toGObject object) cPropertiesGList
g_list_free cPropertiesGList
wrapNewGObject mkController $ return cController
controllerRemoveProperties :: ControllerClass controllerT
=> controllerT
-> [String]
-> IO Bool
controllerRemoveProperties controller properties =
withMany withUTFString properties $ \cProperties ->
do cPropertiesGList <- toGList cProperties
success <- (\(Controller arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gst_controller_remove_properties_list argPtr1 arg2) (toController controller) cPropertiesGList
g_list_free cPropertiesGList
return $ toBool success
foreign import ccall safe "gst_controller_init"
gst_controller_init :: ((Ptr CInt) -> ((Ptr (Ptr (Ptr CChar))) -> (IO CInt)))
foreign import ccall safe "gst_controller_new_list"
gst_controller_new_list :: ((Ptr GObject) -> ((Ptr ()) -> (IO (Ptr Controller))))
foreign import ccall safe "g_list_free"
g_list_free :: ((Ptr ()) -> (IO ()))
foreign import ccall safe "gst_controller_remove_properties_list"
gst_controller_remove_properties_list :: ((Ptr Controller) -> ((Ptr ()) -> (IO CInt)))