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

  GhostPad,
  GhostPadClass,
  castToGhostPad,
  gTypeGhostPad,

  ghostPadNew,
  ghostPadNewNoTarget,

  ghostPadNewFromTemplate,
  ghostPadNewNoTargetFromTemplate,

  ghostPadSetTarget,
  ghostPadGetTarget

  ) where

import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.UTFString
import Media.Streaming.GStreamer.Core.Types
{-# LINE 52 "./Media/Streaming/GStreamer/Core/GhostPad.chs" #-}


{-# LINE 54 "./Media/Streaming/GStreamer/Core/GhostPad.chs" #-}

ghostPadNew :: PadClass pad
            => String
            -> pad
            -> IO (Maybe Pad)
ghostPadNew name target =
    (withUTFString name $
         flip (\arg1 (Pad arg2) -> withForeignPtr arg2 $ \argPtr2 ->gst_ghost_pad_new arg1 argPtr2) $ toPad target) >>=
        maybePeek takeObject

ghostPadNewNoTarget :: String
                    -> PadDirection
                    -> IO (Maybe Pad)
ghostPadNewNoTarget name dir =
    (withUTFString name $
         flip gst_ghost_pad_new_no_target $ cFromEnum dir) >>=
        maybePeek takeObject


ghostPadNewFromTemplate :: String
                        -> Pad
                        -> PadTemplate
                        -> IO (Maybe Pad)
ghostPadNewFromTemplate name target templ =
    withUTFString name $ \cName ->
        (\arg1 (Pad arg2) (PadTemplate arg3) -> withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->gst_ghost_pad_new_from_template arg1 argPtr2 argPtr3) cName target templ >>=
            maybePeek takeObject

ghostPadNewNoTargetFromTemplate :: String
                                -> PadTemplate
                                -> IO (Maybe Pad)
ghostPadNewNoTargetFromTemplate name templ =
    withUTFString name $ \cName ->
        (\arg1 (PadTemplate arg2) -> withForeignPtr arg2 $ \argPtr2 ->gst_ghost_pad_new_no_target_from_template arg1 argPtr2) cName templ >>=
            maybePeek takeObject


ghostPadSetTarget :: GhostPad
                  -> Pad
                  -> IO Bool
ghostPadSetTarget gpad newtarget =
    liftM toBool $ (\(GhostPad arg1) (Pad arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gst_ghost_pad_set_target argPtr1 argPtr2) gpad newtarget

ghostPadGetTarget :: GhostPad
                  -> IO Pad
ghostPadGetTarget gpad =
    (\(GhostPad arg1) -> withForeignPtr arg1 $ \argPtr1 ->gst_ghost_pad_get_target argPtr1) gpad >>= takeObject

foreign import ccall safe "gst_ghost_pad_new"
  gst_ghost_pad_new :: ((Ptr CChar) -> ((Ptr Pad) -> (IO (Ptr Pad))))

foreign import ccall safe "gst_ghost_pad_new_no_target"
  gst_ghost_pad_new_no_target :: ((Ptr CChar) -> (CInt -> (IO (Ptr Pad))))

foreign import ccall safe "gst_ghost_pad_new_from_template"
  gst_ghost_pad_new_from_template :: ((Ptr CChar) -> ((Ptr Pad) -> ((Ptr PadTemplate) -> (IO (Ptr Pad)))))

foreign import ccall safe "gst_ghost_pad_new_no_target_from_template"
  gst_ghost_pad_new_no_target_from_template :: ((Ptr CChar) -> ((Ptr PadTemplate) -> (IO (Ptr Pad))))

foreign import ccall safe "gst_ghost_pad_set_target"
  gst_ghost_pad_set_target :: ((Ptr GhostPad) -> ((Ptr Pad) -> (IO CInt)))

foreign import ccall safe "gst_ghost_pad_get_target"
  gst_ghost_pad_get_target :: ((Ptr GhostPad) -> (IO (Ptr Pad)))