{-# LINE 2 "./Media/Streaming/GStreamer/Base/Adapter.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.Adapter (

  Adapter,
  AdapterClass,
  castToAdapter,
  gTypeAdapter,

  adapterNew,
  adapterClear,
  adapterPush,

  adapterPeek,

  adapterCopy,
  adapterCopyInto,


  adapterFlush,
  adapterAvailable,
  adapterAvailableFast,

  adapterTake,

  adapterTakeBuffer

  ) where

import Control.Monad (liftM)






import qualified Data.ByteString as BS



import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Internal as BS



import Media.Streaming.GStreamer.Base.Types
{-# LINE 74 "./Media/Streaming/GStreamer/Base/Adapter.chs" #-}
import System.Glib.FFI
import System.Glib.GObject
import System.Glib.Flags
import System.Glib.Attributes
import System.Glib.Properties
{-# LINE 79 "./Media/Streaming/GStreamer/Base/Adapter.chs" #-}


{-# LINE 81 "./Media/Streaming/GStreamer/Base/Adapter.chs" #-}

adapterNew :: IO Adapter
adapterNew =
    wrapNewGObject mkAdapter gst_adapter_new
{-# LINE 85 "./Media/Streaming/GStreamer/Base/Adapter.chs" #-}

adapterClear :: AdapterClass adapterT
             => adapterT
             -> IO ()
adapterClear =
    (\(Adapter arg1) -> withForeignPtr arg1 $ \argPtr1 ->gst_adapter_clear argPtr1) . toAdapter

adapterPush :: (AdapterClass adapterT, BufferClass bufferT)
            => adapterT
            -> bufferT
            -> IO ()
adapterPush adapter buffer =
    (\(Adapter arg1) (Buffer arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gst_adapter_push argPtr1 argPtr2) (toAdapter adapter) (toBuffer buffer)


adapterPeek :: AdapterClass adapterT
            => adapterT
            -> Word
            -> IO (Maybe BS.ByteString)
adapterPeek adapter size =
    do ptr <- (\(Adapter arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gst_adapter_peek argPtr1 arg2) (toAdapter adapter) (fromIntegral size)
       if ptr == nullPtr
           then return Nothing
           else liftM Just $



                BS.packCStringLen

                     (castPtr ptr, fromIntegral size)


adapterCopy :: AdapterClass adapterT
            => adapterT
            -> Word
            -> Word
            -> IO BS.ByteString
adapterCopy adapter offset size = do
    BS.create (fromIntegral size) $ \dest ->
        (\(Adapter arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->gst_adapter_copy argPtr1 arg2 arg3 arg4) (toAdapter adapter)
                                (castPtr dest)
                                (fromIntegral offset)
                                (fromIntegral size)

adapterCopyInto :: AdapterClass adapterT
                => adapterT
                -> BS.ByteString
                -> Word
                -> IO ()
adapterCopyInto adapter dest offset =
    BS.useAsCStringLen dest $ \(destPtr, size) ->
        (\(Adapter arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->gst_adapter_copy argPtr1 arg2 arg3 arg4) (toAdapter adapter)
                                (castPtr destPtr)
                                (fromIntegral offset)
                                (fromIntegral size)



adapterFlush :: AdapterClass adapterT
             => adapterT
             -> Word
             -> IO ()
adapterFlush adapter flush =
    (\(Adapter arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gst_adapter_flush argPtr1 arg2) (toAdapter adapter) $ fromIntegral flush

adapterAvailable :: AdapterClass adapterT
                 => adapterT
                 -> IO Word
adapterAvailable adapter =
    liftM fromIntegral $
        (\(Adapter arg1) -> withForeignPtr arg1 $ \argPtr1 ->gst_adapter_available argPtr1) $ toAdapter adapter

adapterAvailableFast :: AdapterClass adapterT
                     => adapterT
                     -> IO Word
adapterAvailableFast adapter =
    liftM fromIntegral $
        (\(Adapter arg1) -> withForeignPtr arg1 $ \argPtr1 ->gst_adapter_available_fast argPtr1) $ toAdapter adapter


adapterTake :: AdapterClass adapterT
            => adapterT
            -> Word
            -> IO (Maybe BS.ByteString)
adapterTake adapter nBytes =
    do ptr <- (\(Adapter arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gst_adapter_take argPtr1 arg2) (toAdapter adapter)
                                      (fromIntegral nBytes)
       if ptr == nullPtr
          then do fPtr <- newForeignPtr (castPtr ptr) gFreePtr
                  return $ Just $
                      BS.fromForeignPtr (castForeignPtr fPtr)

                                        0

                                        (fromIntegral nBytes)
          else return Nothing
foreign import ccall unsafe "&g_free"
    gFreePtr :: FunPtr (Ptr () -> IO ())


adapterTakeBuffer :: AdapterClass adapterT
                  => adapterT
                  -> Word
                  -> IO (Maybe Buffer)
adapterTakeBuffer adapter nBytes =
    (\(Adapter arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gst_adapter_take_buffer argPtr1 arg2) (toAdapter adapter) (fromIntegral nBytes) >>=
        maybePeek takeMiniObject

foreign import ccall safe "gst_adapter_new"
  gst_adapter_new :: (IO (Ptr Adapter))

foreign import ccall safe "gst_adapter_clear"
  gst_adapter_clear :: ((Ptr Adapter) -> (IO ()))

foreign import ccall safe "gst_adapter_push"
  gst_adapter_push :: ((Ptr Adapter) -> ((Ptr Buffer) -> (IO ())))

foreign import ccall safe "gst_adapter_peek"
  gst_adapter_peek :: ((Ptr Adapter) -> (CUInt -> (IO (Ptr CUChar))))

foreign import ccall safe "gst_adapter_copy"
  gst_adapter_copy :: ((Ptr Adapter) -> ((Ptr CUChar) -> (CUInt -> (CUInt -> (IO ())))))

foreign import ccall safe "gst_adapter_flush"
  gst_adapter_flush :: ((Ptr Adapter) -> (CUInt -> (IO ())))

foreign import ccall safe "gst_adapter_available"
  gst_adapter_available :: ((Ptr Adapter) -> (IO CUInt))

foreign import ccall safe "gst_adapter_available_fast"
  gst_adapter_available_fast :: ((Ptr Adapter) -> (IO CUInt))

foreign import ccall safe "gst_adapter_take"
  gst_adapter_take :: ((Ptr Adapter) -> (CUInt -> (IO (Ptr CUChar))))

foreign import ccall safe "gst_adapter_take_buffer"
  gst_adapter_take_buffer :: ((Ptr Adapter) -> (CUInt -> (IO (Ptr Buffer))))