gstreamer-0.11.0: Media/Streaming/GStreamer/Core/Bus.chs
{-# LANGUAGE CPP #-}
-- GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*-
--
-- Author : Peter Gavin
-- Created: 1-Apr-2007
--
-- Copyright (c) 2007 Peter Gavin
--
-- This library is free software: you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public License
-- as published by the Free Software Foundation, either version 3 of
-- the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this program. If not, see
-- <http://www.gnu.org/licenses/>.
--
-- GStreamer, the C library which this Haskell library depends on, is
-- available under LGPL Version 2. The documentation included with
-- this library is based on the original GStreamer documentation.
--
-- |
-- Maintainer : gtk2hs-devel@lists.sourceforge.net
-- Stability : alpha
-- Portability : portable (depends on GHC)
--
-- An asynchronous message bus subsystem.
module Media.Streaming.GStreamer.Core.Bus (
-- * Detail
-- | The 'Bus' is resposible for delivering 'Message's in a
-- first-in, first-out order, from the streaming threads to the
-- application.
--
-- Since the application typically only wants to deal with
-- delivery of these messages from one thread, the 'Bus' will
-- marshal the messages between different threads. This is
-- important since the actual streaming of media is done in
-- a thread separate from the application.
--
-- The 'Bus' provides support for 'System.Glib.MainLoop.Source'
-- based notifications. This makes it possible to handle the
-- delivery in the GLib 'System.Glib.MainLoop.Source'.
--
-- A message is posted on the bus with the 'busPost' method. With
-- the 'busPeek' and 'busPop' methods one can look at or retrieve
-- a previously posted message.
--
-- The bus can be polled with the 'busPoll' method. This methods
-- blocks up to the specified timeout value until one of the
-- specified messages types is posted on the bus. The application
-- can then pop the messages from the bus to handle
-- them. Alternatively the application can register an
-- asynchronous bus function using 'busAddWatch'. This function
-- will install a 'System.Glib.MainLoop.Source' in the default
-- GLib main loop and will deliver messages a short while after
-- they have been posted. Note that the main loop should be
-- running for the asynchronous callbacks.
--
-- It is also possible to get messages from the bus without any
-- thread marshalling with the 'busSetSyncHandler' method. This
-- makes it possible to react to a message in the same thread that
-- posted the message on the bus. This should only be used if the
-- application is able to deal with messages from different
-- threads.
--
-- Every 'Pipeline' has one bus.
--
-- Note that a 'Pipeline' will set its bus into flushing state
-- when changing from 'StateReady' to 'StateNull'.
-- * Types
Bus,
BusClass,
-- | The result of a 'BusSyncHandler'.
BusSyncReply,
-- | A handler that will be invoked synchronously when a new message
-- is injected into the bus. This function is mostly used internally.
-- Only one sync handler may be attached to a given bus.
BusSyncHandler,
castToBus,
gTypeBus,
-- * Bus Operations
busGetFlags,
busSetFlags,
busUnsetFlags,
busNew,
busPost,
busHavePending,
busPeek,
busPop,
#if GST_CHECK_VERSION(0,10,12)
busTimedPop,
#endif
busSetFlushing,
busSetSyncHandler,
busUseSyncSignalHandler,
busCreateWatch,
busAddWatch,
busDisableSyncMessageEmission,
busEnableSyncMessageEmission,
busAddSignalWatch,
busRemoveSignalWatch,
busPoll,
-- * Bus Signals
busMessage,
busSyncMessage,
) where
import Control.Monad ( liftM
, when )
{#import Media.Streaming.GStreamer.Core.Object#}
{#import Media.Streaming.GStreamer.Core.Types#}
{#import Media.Streaming.GStreamer.Core.Signals#}
{#import System.Glib.MainLoop#}
import System.Glib.Flags
import System.Glib.FFI
{#import System.Glib.GObject#}
{#import System.Glib.MainLoop#}
{# context lib = "gstreamer" prefix = "gst" #}
-- | Get the flags set on this bus.
busGetFlags :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> IO [BusFlags] -- ^ the flags set on @bus@
busGetFlags = mkObjectGetFlags
-- | Set flags on this bus.
busSetFlags :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> [BusFlags] -- ^ the flags to set on @bus@
-> IO ()
busSetFlags = mkObjectSetFlags
-- | Unset flags on this bus.
busUnsetFlags :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> [BusFlags] -- ^ the flags to unset on @bus@
-> IO ()
busUnsetFlags = mkObjectUnsetFlags
-- | Create a new bus.
busNew :: IO Bus -- ^ the newly created 'Bus' object
busNew =
{# call bus_new #} >>= takeObject
-- | Post a message to the bus.
busPost :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> Message -- ^ @message@ - the message to post
-> IO Bool -- ^ 'True' if the message was posted, or
-- 'False' if the bus is flushing
busPost bus message =
do {# call gst_mini_object_ref #} (toMiniObject message)
liftM toBool $ {# call bus_post #} (toBus bus) message
-- | Check if there are pending messages on the bus.
busHavePending :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> IO Bool -- ^ 'True' if there are messages
-- on the bus to be handled, otherwise 'False'
busHavePending bus =
liftM toBool $ {# call bus_have_pending #} $ toBus bus
-- | Get the message at the front of the queue. Any message returned
-- will remain on the queue.
busPeek :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> IO (Maybe Message) -- ^ the first 'Message' on the bus, or
-- 'Nothing' if the bus is empty
busPeek bus =
{# call bus_peek #} (toBus bus) >>= maybePeek takeMiniObject
-- | Get the message at the front of the queue. It will be removed
-- from the queue.
busPop :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> IO (Maybe Message) -- ^ the first 'Message' on the bus, or
-- 'Nothing' if the bus is empty
busPop bus =
{# call bus_pop #} (toBus bus) >>= maybePeek takeMiniObject
#if GST_CHECK_VERSION(0,10,12)
-- | Get a message from the bus, waiting up to the specified timeout.
-- If the time given is 'Nothing', the function will wait forever.
-- If the time given is @0@, the function will behave like 'busPop'.
--
-- Since 0.10.12.
busTimedPop :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> Maybe ClockTime -- ^ @timeoutM@ - the time to wait for,
-- or 'Nothing' to wait forever
-> IO (Maybe Message) -- ^ the first message recieved, or
-- 'Nothing' if the timeout has expired
busTimedPop bus timeoutM =
let timeout = case timeoutM of
Just timeout' -> timeout'
Nothing -> clockTimeNone
in {# call bus_timed_pop #} (toBus bus) (fromIntegral timeout) >>=
maybePeek takeMiniObject
#endif
-- | If @flushing@ is 'True', the bus will flush out any queued
-- messages, as well as any future messages, until the function is
-- called with @flushing@ set to 'False'.
busSetFlushing :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> Bool -- ^ @flushing@ - the new flushing state
-> IO ()
busSetFlushing bus flushing =
{# call bus_set_flushing #} (toBus bus) $ fromBool flushing
type CBusSyncHandler = Ptr Bus
-> Ptr Message
-> {# type gpointer #}
-> IO {# type GstBusSyncReply #}
marshalBusSyncHandler :: BusSyncHandler
-> IO {# type GstBusSyncHandler #}
marshalBusSyncHandler busSyncHandler =
makeBusSyncHandler cBusSyncHandler
where cBusSyncHandler :: CBusSyncHandler
cBusSyncHandler busPtr messagePtr _ =
do bus <- peekObject busPtr
message <- peekMiniObject messagePtr
reply <- busSyncHandler bus message
when (reply == BusDrop) $
{# call gst_mini_object_unref #} (toMiniObject message)
return $ fromIntegral $ fromEnum reply
foreign import ccall "wrapper"
makeBusSyncHandler :: CBusSyncHandler
-> IO {# type GstBusSyncHandler #}
-- See Graphics.UI.Gtk.General.Clipboard.clipboardSetWithData for an
-- explanation of this hack.
funPtrQuark :: Quark
funPtrQuark = unsafePerformIO $ quarkFromString "Gtk2HS::SyncHandlerFunPtr"
-- | Set the synchronous message handler on the bus. The function will
-- be called every time a new message is posted to the bus. Note
-- that the function will be called from the thread context of the
-- poster.
--
-- Calling this function will replace any previously set sync
-- handler. If 'Nothing' is passed to this function, it will unset
-- the handler.
busSetSyncHandler :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> Maybe BusSyncHandler -- ^ @busSyncHandlerM@ - the new 'BusSyncHandler'
-> IO ()
busSetSyncHandler bus Nothing = objectWithLock bus $ do
{#call bus_set_sync_handler #} (toBus bus) nullFunPtr nullPtr
{#call unsafe g_object_set_qdata#} (toGObject bus) funPtrQuark nullPtr
busSetSyncHandler bus (Just busSyncHandler) = objectWithLock bus $ do
funPtr <- marshalBusSyncHandler busSyncHandler
{#call bus_set_sync_handler #} (toBus bus) funPtr nullPtr
{#call unsafe g_object_set_qdata_full#} (toGObject bus) funPtrQuark
(castFunPtrToPtr funPtr) destroyFunPtr
-- | Use a synchronous message handler that converts all messages to signals.
busUseSyncSignalHandler :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> IO ()
busUseSyncSignalHandler bus = objectWithLock bus $ do
{# call bus_set_sync_handler #} (toBus bus) cBusSyncSignalHandlerPtr nullPtr
{#call unsafe g_object_set_qdata#} (toGObject bus) funPtrQuark nullPtr
foreign import ccall unsafe "&gst_bus_sync_signal_handler"
cBusSyncSignalHandlerPtr :: {# type GstBusSyncHandler #}
-- | Create a watch for the bus. The 'Source' will dispatch a signal
-- whenever a message is on the bus. After the signal is dispatched,
-- the message is popped off the bus.
busCreateWatch :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> IO Source -- ^ the new event 'Source'
busCreateWatch bus =
liftM Source $ {# call bus_create_watch #} (toBus bus) >>=
flip newForeignPtr sourceFinalizer
foreign import ccall unsafe "&g_source_unref"
sourceFinalizer :: FunPtr (Ptr Source -> IO ())
type CBusFunc = Ptr Bus
-> Ptr Message
-> {# type gpointer #}
-> IO {# type gboolean #}
marshalBusFunc :: BusFunc
-> IO {# type GstBusFunc #}
marshalBusFunc busFunc =
makeBusFunc cBusFunc
where cBusFunc :: CBusFunc
cBusFunc busPtr messagePtr userData =
do bus <- peekObject busPtr
message <- peekMiniObject messagePtr
liftM fromBool $ busFunc bus message
foreign import ccall "wrapper"
makeBusFunc :: CBusFunc
-> IO {# type GstBusFunc #}
-- | Adds a bus watch to the default main context with the given
-- priority. This function is used to receive asynchronous messages
-- in the main loop.
--
-- The watch can be removed by calling 'System.Glib.MainLoop.sourceRemove'.
busAddWatch :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> Priority -- ^ @priority@ - the priority of the watch
-> BusFunc -- ^ @func@ - the action to perform when a message is recieved
-> IO HandlerId -- ^ the event source ID
busAddWatch bus priority func =
do busFuncPtr <- marshalBusFunc func
liftM fromIntegral $
{# call bus_add_watch_full #}
(toBus bus)
(fromIntegral priority)
busFuncPtr
(castFunPtrToPtr busFuncPtr)
destroyFunPtr
-- | Instructs GStreamer to stop emitting the 'busSyncMessage' signal
-- for this bus. See 'busEnableSyncMessageEmission' for more
-- information.
--
-- In the event that multiple pieces of code have called
-- 'busEnableSyncMessageEmission', the sync-message
-- emissions will only be stopped after all calls to
-- 'busEnableSyncMessageEmission' were "cancelled" by
-- calling this function.
busDisableSyncMessageEmission :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> IO ()
busDisableSyncMessageEmission =
{# call bus_disable_sync_message_emission #} . toBus
-- | Instructs GStreamer to emit the 'busSyncMessage' signal after
-- running the bus's sync handler. This function is here so that
-- programmers can ensure that they can synchronously receive
-- messages without having to affect what the bin's sync handler is.
--
-- This function may be called multiple times. To clean up, the
-- caller is responsible for calling 'busDisableSyncMessageEmission'
-- as many times as this function is called.
--
-- While this function looks similar to 'busAddSignalWatch', it is
-- not exactly the same -- this function enables synchronous
-- emission of signals when messages arrive; 'busAddSignalWatch'
-- adds an idle callback to pop messages off the bus
-- asynchronously. The 'busSyncMessage' signal comes from the thread
-- of whatever object posted the message; the 'busMessage' signal is
-- marshalled to the main thread via the main loop.
busEnableSyncMessageEmission :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> IO ()
busEnableSyncMessageEmission =
{# call bus_enable_sync_message_emission #} . toBus
-- | Adds a bus signal watch to the default main context with the
-- given priority. After calling this method, the bus will emit the
-- 'busMessage' signal for each message posted on the bus.
--
-- This function may be called multiple times. To clean up, the
-- caller is responsible for calling 'busRemoveSignalWatch' as many
-- times.
busAddSignalWatch :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> Priority -- ^ @priority@ - the priority of the watch
-> IO ()
busAddSignalWatch bus priority =
{# call bus_add_signal_watch_full #} (toBus bus) $ fromIntegral priority
-- | Remove the signal watch that was added with 'busAddSignalWatch'.
busRemoveSignalWatch :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> IO ()
busRemoveSignalWatch =
{# call bus_remove_signal_watch #} . toBus
-- | Poll the bus for a message. Will block while waiting for messages
-- to come. You can specify the maximum amount of time to wait with
-- the @timeout@ parameter. If @timeout@ is negative, the function
-- will wait indefinitely.
--
-- Messages not in @events@ will be popped off the bus and ignored.
--
-- Because 'busPoll' is implemented using the 'busMessage' signal
-- enabled by 'busAddSignalWatch', calling 'busPoll' will cause the
-- 'busMessage' signal to be emitted for every message that the
-- function sees. Thus, a 'busMessage' signal handler will see every
-- message that 'busPoll' sees -- neither will steal messages from
-- the other.
--
-- This function will run a main loop in the default main context
-- while polling.
busPoll :: BusClass busT
=> busT -- ^ @bus@ - a 'Bus'
-> [MessageType] -- ^ @events@ - the set of messages to poll for
-> ClockTimeDiff -- ^ @timeout@ - the time to wait, or -1 to wait indefinitely
-> IO Message
busPoll bus events timeout =
{# call bus_poll #} (toBus bus)
(fromIntegral $ fromFlags events)
(fromIntegral timeout) >>=
takeMiniObject
-- | A message has been posted on the bus. This signal is emitted from
-- a 'Source' added to the 'MainLoop', and only when it is running.
busMessage :: BusClass busT
=> Signal busT (Message -> IO ())
busMessage =
Signal $ connect_BOXED__NONE "message" peekMiniObject
-- | A message has been posted on the bus. This signal is emitted from
-- the thread that posted the message so one has to be careful with
-- locking.
--
-- This signal will not be emitted by default, you must first call
-- 'busUseSyncSignalHandler' if you want this signal to be emitted
-- when a message is posted on the bus.
busSyncMessage :: BusClass busT
=> Signal busT (Message -> IO ())
busSyncMessage =
Signal $ connect_BOXED__NONE "sync-message" peekMiniObject