{-# LINE 2 "./Media/Streaming/GStreamer/Base/BaseSink.chs" #-}
-- 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:
--
-- 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)
module Media.Streaming.GStreamer.Base.BaseSink (

  BaseSink,
  BaseSinkClass,
  castToBaseSink,
  gTypeBaseSink,


  baseSinkQueryLatency,
  baseSinkGetLatency,


  baseSinkWaitPreroll,

  baseSinkSetSync,
  baseSinkGetSync,
  baseSinkSetMaxLateness,
  baseSinkGetMaxLateness,
  baseSinkIsQOSEnabled,
  baseSinkSetQOSEnabled,
  baseSinkPrerollQueueLength,
  baseSinkGetPad

  ) where

import Control.Monad (liftM, liftM4)
import Media.Streaming.GStreamer.Base.Types
{-# LINE 57 "./Media/Streaming/GStreamer/Base/BaseSink.chs" #-}
import System.Glib.FFI
import System.Glib.Flags
import System.Glib.Attributes
import System.Glib.Properties
{-# LINE 61 "./Media/Streaming/GStreamer/Base/BaseSink.chs" #-}


{-# LINE 63 "./Media/Streaming/GStreamer/Base/BaseSink.chs" #-}


baseSinkQueryLatency :: BaseSinkClass baseSinkT
                     => baseSinkT
                     -> IO (Maybe (Bool, Bool, ClockTime, ClockTime))
baseSinkQueryLatency baseSink =
    alloca $ \livePtr -> alloca $ \upstreamLivePtr ->
        alloca $ \minLatencyPtr -> alloca $ \maxLatencyPtr ->
            do result <- (\(BaseSink arg1) arg2 arg3 arg4 arg5 -> withForeignPtr arg1 $ \argPtr1 ->gst_base_sink_query_latency argPtr1 arg2 arg3 arg4 arg5) (toBaseSink baseSink)
                                                            livePtr
                                                            upstreamLivePtr
                                                            minLatencyPtr
                                                            maxLatencyPtr
               if toBool result
                   then do live <- peek livePtr
                           upstreamLive <- peek upstreamLivePtr
                           minLatency <- peek minLatencyPtr
                           maxLatency <- peek maxLatencyPtr
                           return $ Just (toBool live,
                                          toBool upstreamLive,
                                          cToEnum minLatency,
                                          cToEnum maxLatency)
                   else return Nothing

baseSinkGetLatency :: BaseSinkClass baseSinkT
                   => baseSinkT
                   -> IO ClockTime
baseSinkGetLatency baseSink =
    liftM cToEnum $
        (\(BaseSink arg1) -> withForeignPtr arg1 $ \argPtr1 ->gst_base_sink_get_latency argPtr1) (toBaseSink baseSink)



baseSinkWaitPreroll :: BaseSinkClass baseSinkT
                    => baseSinkT
                    -> IO FlowReturn
baseSinkWaitPreroll baseSink =
    liftM cToEnum $
        (\(BaseSink arg1) -> withForeignPtr arg1 $ \argPtr1 ->gst_base_sink_wait_preroll argPtr1) (toBaseSink baseSink)


baseSinkSetSync :: BaseSinkClass baseSinkT
                => baseSinkT
                -> Bool
                -> IO ()
baseSinkSetSync baseSink sync =
    (\(BaseSink arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gst_base_sink_set_sync argPtr1 arg2) (toBaseSink baseSink) $ fromBool sync

baseSinkGetSync :: BaseSinkClass baseSinkT
                => baseSinkT
                -> IO Bool
baseSinkGetSync baseSink =
    liftM toBool $
        (\(BaseSink arg1) -> withForeignPtr arg1 $ \argPtr1 ->gst_base_sink_get_sync argPtr1) (toBaseSink baseSink)

baseSinkSetMaxLateness :: BaseSinkClass baseSinkT
                       => baseSinkT
                       -> Word64
                       -> IO ()
baseSinkSetMaxLateness baseSink maxLateness =
    (\(BaseSink arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gst_base_sink_set_max_lateness argPtr1 arg2) (toBaseSink baseSink) $ fromIntegral maxLateness

baseSinkGetMaxLateness :: BaseSinkClass baseSinkT
                       => baseSinkT
                       -> IO Word64
baseSinkGetMaxLateness baseSink =
    liftM fromIntegral $
        (\(BaseSink arg1) -> withForeignPtr arg1 $ \argPtr1 ->gst_base_sink_get_max_lateness argPtr1) (toBaseSink baseSink)

baseSinkIsQOSEnabled :: BaseSinkClass baseSinkT
                     => baseSinkT
                     -> IO Bool
baseSinkIsQOSEnabled baseSink =
    liftM toBool $
        (\(BaseSink arg1) -> withForeignPtr arg1 $ \argPtr1 ->gst_base_sink_is_qos_enabled argPtr1) (toBaseSink baseSink)

baseSinkSetQOSEnabled :: BaseSinkClass baseSinkT
                      => baseSinkT
                      -> Bool
                      -> IO ()
baseSinkSetQOSEnabled baseSink enabled =
    (\(BaseSink arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gst_base_sink_set_qos_enabled argPtr1 arg2) (toBaseSink baseSink) $ fromBool enabled

baseSinkPrerollQueueLength :: BaseSinkClass baseSinkT
                           => Attr baseSinkT Int
baseSinkPrerollQueueLength =
    newAttrFromUIntProperty "preroll-queue-len"

baseSinkGetPad :: BaseSinkClass baseSinkT
               => baseSinkT
               -> IO Pad
baseSinkGetPad baseSink =
    withObject (toBaseSink baseSink) cBaseSinkGetPad >>= peekObject
foreign import ccall unsafe "_hs_gst_base_sink_get_pad"
    cBaseSinkGetPad :: Ptr BaseSink
                    -> IO (Ptr Pad)

foreign import ccall safe "gst_base_sink_query_latency"
  gst_base_sink_query_latency :: ((Ptr BaseSink) -> ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CULLong) -> ((Ptr CULLong) -> (IO CInt))))))

foreign import ccall safe "gst_base_sink_get_latency"
  gst_base_sink_get_latency :: ((Ptr BaseSink) -> (IO CULLong))

foreign import ccall safe "gst_base_sink_wait_preroll"
  gst_base_sink_wait_preroll :: ((Ptr BaseSink) -> (IO CInt))

foreign import ccall safe "gst_base_sink_set_sync"
  gst_base_sink_set_sync :: ((Ptr BaseSink) -> (CInt -> (IO ())))

foreign import ccall safe "gst_base_sink_get_sync"
  gst_base_sink_get_sync :: ((Ptr BaseSink) -> (IO CInt))

foreign import ccall safe "gst_base_sink_set_max_lateness"
  gst_base_sink_set_max_lateness :: ((Ptr BaseSink) -> (CLLong -> (IO ())))

foreign import ccall safe "gst_base_sink_get_max_lateness"
  gst_base_sink_get_max_lateness :: ((Ptr BaseSink) -> (IO CLLong))

foreign import ccall safe "gst_base_sink_is_qos_enabled"
  gst_base_sink_is_qos_enabled :: ((Ptr BaseSink) -> (IO CInt))

foreign import ccall safe "gst_base_sink_set_qos_enabled"
  gst_base_sink_set_qos_enabled :: ((Ptr BaseSink) -> (CInt -> (IO ())))