[project @ 2004-12-18 20:45:50 by duncan_coutts] tidy up module header

-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget embedding the Mozilla browser engine (Gecko)
--
--  Author : Jonas Svensson
--
--  Created: 26 February 2002
--
--  Version $Revision: 1.2 $ from $Date: 2004/12/18 20:45:50 $
--
--  Copyright (c) 2002 Jonas Svensson
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
--  Modified 2004 by Scott West for basic use in gtk2hs
--
--  Further modified 2004 by Wolfram Kahl:
--  * ported to gtk2hs/c2hs
--  * added additional interface functions
--  * circumvented render_data problem
--
-- | This widgets embeds Mozilla's browser engine (Gecko) into a GTK+ widget.
-- See <http://www.mozilla.org/unix/gtk-embedding.html> for an API reference.
--
module Graphics.UI.Gtk.MozEmbed (
  MozEmbed, MozEmbedClass,

  mozEmbedNew, mozEmbedSetCompPath,

  mozEmbedRenderData,
  mozEmbedOpenStream, mozEmbedAppendData, mozEmbedCloseStream,

  onOpenURI,

  mozEmbedLoadUrl,

  -- the functions below are untested.

  onKeyDown, onKeyPress, onKeyUp,
  onMouseDown, onMouseUp, onMouseClick, onMouseDoubleClick,
  onMouseOver, onMouseOut,

  mozEmbedSetProfilePath,
  mozEmbedStopLoad, mozEmbedGoBack, mozEmbedGoForward, mozEmbedGetLinkMessage,
  mozEmbedGetJsStatus, mozEmbedGetTitle, mozEmbedGetLocation,
  mozEmbedCanGoBack, mozEmbedCanGoForward, mozEmbedPushStartup,
  mozEmbedPopStartup
) where

import Monad		(liftM)
import FFI
import ForeignPtr
import Foreign.Marshal.Utils (toBool)

{#import Object#}    (makeNewObject)
{#import Signal#}    (ConnectId, connect_STRING__BOOL, connect_PTR__INT)
{#import Graphics.UI.Gtk.MozEmbedType #}
import Widget (Widget)

{#context lib="gtkembedmoz" prefix ="gtk"#}

-- operations
-- ----------

-- | Create a new MozEmbed
--
mozEmbedNew :: IO MozEmbed
mozEmbedNew = makeNewObject mkMozEmbed $ liftM castPtr {#call moz_embed_new#}

mozEmbedSetCompPath :: String -> IO ()
mozEmbedSetCompPath str =
  withCString str $ \strPtr ->
   {#call moz_embed_set_comp_path#}
   strPtr

mozEmbedSetProfilePath :: String -> String -> IO ()
mozEmbedSetProfilePath dir name =
  withCString dir $ \dirPtr ->
   withCString name $ \namePtr ->
    {#call moz_embed_set_profile_path#} dirPtr namePtr

mozEmbedLoadUrl :: MozEmbedClass m => m -> String -> IO ()
mozEmbedLoadUrl m url =
  withCString url $ \urlPtr ->
   {#call moz_embed_load_url#}
   (toMozEmbed m)
   urlPtr

mozEmbedStopLoad :: MozEmbedClass m => m -> IO ()
mozEmbedStopLoad m =
  {#call moz_embed_stop_load#} (toMozEmbed m)

mozEmbedGoBack :: MozEmbedClass m => m -> IO ()
mozEmbedGoBack m =
  {#call moz_embed_go_back#} (toMozEmbed m)

mozEmbedGoForward :: MozEmbedClass m => m -> IO ()
mozEmbedGoForward m =
  {#call moz_embed_go_forward#} (toMozEmbed m)

mozEmbedGetLinkMessage :: MozEmbedClass m => m -> IO String
mozEmbedGetLinkMessage m =
  do
   str <- {#call moz_embed_get_link_message#} (toMozEmbed m)
   peekCString str

mozEmbedGetJsStatus :: MozEmbedClass m => m -> IO String
mozEmbedGetJsStatus m =
  do
   str <- {#call moz_embed_get_js_status#} (toMozEmbed m)
   peekCString str

mozEmbedGetTitle :: MozEmbedClass m => m -> IO String
mozEmbedGetTitle m =
  do
   str <- {#call moz_embed_get_title#} (toMozEmbed m)
   peekCString str

mozEmbedGetLocation :: MozEmbedClass m => m -> IO String
mozEmbedGetLocation m =
  do
   str <- {#call moz_embed_get_location#} (toMozEmbed m)
   peekCString str

mozEmbedCanGoBack :: MozEmbedClass m => m -> IO Bool
mozEmbedCanGoBack m =
  liftM toBool $
   {#call moz_embed_can_go_back#} (toMozEmbed m)

mozEmbedCanGoForward :: MozEmbedClass m => m -> IO Bool
mozEmbedCanGoForward m =
  liftM toBool $
   {#call moz_embed_can_go_forward#} (toMozEmbed m)

mozEmbedPushStartup :: IO ()
mozEmbedPushStartup =
  {#call moz_embed_push_startup#}

mozEmbedPopStartup :: IO ()
mozEmbedPopStartup =
  {#call moz_embed_pop_startup#}

{-
void         gtk_moz_embed_open_stream      (GtkMozEmbed *embed,
					     const char *base_uri,
					     const char *mime_type);
void         gtk_moz_embed_append_data      (GtkMozEmbed *embed,
					     const char *data, guint32 len);
void         gtk_moz_embed_close_stream     (GtkMozEmbed *embed);
-}

mozEmbedOpenStream :: MozEmbedClass m => m -> String -> String -> IO ()
mozEmbedOpenStream m baseURI mimeType =
  withCString baseURI  $ \ basePtr ->
  withCString mimeType $ \ mtPtr ->
  {#call gtk_moz_embed_open_stream#} (toMozEmbed m) basePtr mtPtr

mozEmbedAppendDataInternal :: MozEmbedClass m => m -> String -> IO ()
mozEmbedAppendDataInternal m contents =
--  newCStringLen (toUTF contents) >>= \ (dataPtr,len) ->
  withUTFStringLen contents $ \ (dataPtr,len) ->      -- alloca discouraged?
  let len' = fromIntegral len in
  {#call gtk_moz_embed_append_data#} (toMozEmbed m) dataPtr len'
--  >> free dataPtr

mozEmbedCloseStream :: MozEmbedClass m => m -> IO ()
mozEmbedCloseStream m =
  {#call gtk_moz_embed_close_stream#} (toMozEmbed m)

mozEmbedAppendData :: MozEmbedClass m => m -> String -> IO ()
mozEmbedAppendData m contents =
  mapM_ (mozEmbedAppendDataInternal m) (chunks 32768 contents)

mozEmbedRenderData :: MozEmbedClass m => m -> String -> String -> String -> IO ()
mozEmbedRenderData m contents baseURI mimeType = do
  mozEmbedOpenStream m baseURI mimeType
  mozEmbedAppendData m contents
  mozEmbedCloseStream m

chunks :: Int -> [a] -> [[a]]
chunks n [] = []
chunks n xs = let (ys, zs) = splitAt n xs in ys : chunks n zs

{-
void         gtk_moz_embed_render_data      (GtkMozEmbed *embed,
                                             const char *data,
                                             guint32 len,
                                             const char *base_uri,
                                             const char *mime_type)
-}
--  -- mozEmbedRenderDataInternal does not work for len' > 2^16
mozEmbedRenderDataInternal :: MozEmbedClass m => m -> String -> String -> String -> IO ()
mozEmbedRenderDataInternal m contents baseURI mimeType =
--  newCStringLen (toUTF contents) >>= \ (dataPtr,len) ->
  withUTFStringLen contents $ \ (dataPtr,len) ->      -- alloca discouraged
  let len' = fromIntegral len in
--  hPutStrLn stderr ("mozEmbedRenderData: " ++ shows len' " bytes") >>= \ _ ->
  withCString baseURI  $ \ basePrt ->
  withCString mimeType $ \ mtPtr ->
  {#call gtk_moz_embed_render_data#} (toMozEmbed m) dataPtr len' basePrt mtPtr
--  >> free dataPtr

{-
struct _GtkMozEmbedClass
{
  [...]
  gint (* open_uri)            (GtkMozEmbed *embed, const char *aURI);
  [...]
}
-}

onOpenURI :: MozEmbedClass m => m -> (String -> IO Bool) -> IO (ConnectId m)
onOpenURI = connect_STRING__BOOL "open_uri" after
 where
-- Specify if the handler is to run before (False) or after (True) the
-- default handler.
  after = False

{-
More signals to investigate:

  gint (* dom_key_down)        (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_key_press)       (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_key_up)          (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_down)      (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_up)        (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_click)     (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_dbl_click) (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_over)      (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_out)       (GtkMozEmbed *embed, gpointer dom_event);

Unfortunateley these are not documented on

http://www.mozilla.org/unix/gtk-embedding.html

-}

onKeyDown, onKeyPress, onKeyUp,
 onMouseDown, onMouseUp, onMouseClick, onMouseDoubleClick,
 onMouseOver, onMouseOut
 :: (Num n, Integral n, MozEmbedClass m)
 => m -> (Ptr a -> IO n) -> IO (ConnectId m)
onKeyDown          = connect_PTR__INT "dom_key_down" False
onKeyPress         = connect_PTR__INT "dom_key_press" False
onKeyUp            = connect_PTR__INT "dom_key_up" False
onMouseDown        = connect_PTR__INT "dom_mouse_down" False
onMouseUp          = connect_PTR__INT "dom_mouse_up" False
onMouseClick       = connect_PTR__INT "dom_mouse_click" False
onMouseDoubleClick = connect_PTR__INT "dom_mouse_dbl_click" False
onMouseOver        = connect_PTR__INT "dom_mouse_over" False
onMouseOut         = connect_PTR__INT "dom_mouse_out" False

-- |GIMP Toolkit (GTK) Binding for Haskell: widget embedding the  -*-haskell-*-
--    Mozilla browser engine (Gecko)
--
--  Author : Jonas Svensson
--  Created: 26 February 2002
--
--  Version $Revision: 1.1 $ from $Date: 2004/12/17 21:21:44 $
--
--  Copyright (c) 2002 Jonas Svensson
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
--
--  Modified 2004 by Scott West for basic use in gtk2hs
--
--  Further modified 2004 by Wolfram Kahl:
--  * ported to gtk2hs/c2hs
--  * added additional interface functions
--  * circumvented render_data problem
--
--
--- DESCRIPTION ---------------------------------------------------------------
--
--  This widgets embeds Mozilla's browser engine (Gecko) into a GTK+ widget.
--
--- DOCU ----------------------------------------------------------------------
--
--  Language: Haskell 98 Binding Module
--
--- TODO ----------------------------------------------------------------------
--

module Graphics.UI.Gtk.MozEmbed (
  MozEmbed, MozEmbedClass,

  mozEmbedNew, mozEmbedSetCompPath,

  mozEmbedRenderData,
  mozEmbedOpenStream, mozEmbedAppendData, mozEmbedCloseStream,

  onOpenURI,

  mozEmbedLoadUrl,

  -- the functions below are untested.

  onKeyDown, onKeyPress, onKeyUp,
  onMouseDown, onMouseUp, onMouseClick, onMouseDoubleClick,
  onMouseOver, onMouseOut,

  mozEmbedSetProfilePath,
  mozEmbedStopLoad, mozEmbedGoBack, mozEmbedGoForward, mozEmbedGetLinkMessage,
  mozEmbedGetJsStatus, mozEmbedGetTitle, mozEmbedGetLocation,
  mozEmbedCanGoBack, mozEmbedCanGoForward, mozEmbedPushStartup,
  mozEmbedPopStartup
) where

import Monad		(liftM)
import FFI
import ForeignPtr
import Foreign.Marshal.Utils (toBool)

{#import Object#}    (makeNewObject)
{#import Signal#}    (ConnectId, connect_STRING__BOOL, connect_PTR__INT)
{#import Graphics.UI.Gtk.MozEmbedType #}
import Widget (Widget)

{#context lib="gtkembedmoz" prefix ="gtk"#}

-- operations
-- ----------

-- | Create a new MozEmbed
--
mozEmbedNew :: IO MozEmbed
mozEmbedNew = makeNewObject mkMozEmbed $ liftM castPtr {#call moz_embed_new#}

mozEmbedSetCompPath :: String -> IO ()
mozEmbedSetCompPath str =
  withCString str $ \strPtr ->
   {#call moz_embed_set_comp_path#}
   strPtr

mozEmbedSetProfilePath :: String -> String -> IO ()
mozEmbedSetProfilePath dir name =
  withCString dir $ \dirPtr ->
   withCString name $ \namePtr ->
    {#call moz_embed_set_profile_path#} dirPtr namePtr

mozEmbedLoadUrl :: MozEmbedClass m => m -> String -> IO ()
mozEmbedLoadUrl m url =
  withCString url $ \urlPtr ->
   {#call moz_embed_load_url#}
   (toMozEmbed m)
   urlPtr

mozEmbedStopLoad :: MozEmbedClass m => m -> IO ()
mozEmbedStopLoad m =
  {#call moz_embed_stop_load#} (toMozEmbed m)

mozEmbedGoBack :: MozEmbedClass m => m -> IO ()
mozEmbedGoBack m =
  {#call moz_embed_go_back#} (toMozEmbed m)

mozEmbedGoForward :: MozEmbedClass m => m -> IO ()
mozEmbedGoForward m =
  {#call moz_embed_go_forward#} (toMozEmbed m)

mozEmbedGetLinkMessage :: MozEmbedClass m => m -> IO String
mozEmbedGetLinkMessage m =
  do
   str <- {#call moz_embed_get_link_message#} (toMozEmbed m)
   peekCString str

mozEmbedGetJsStatus :: MozEmbedClass m => m -> IO String
mozEmbedGetJsStatus m =
  do
   str <- {#call moz_embed_get_js_status#} (toMozEmbed m)
   peekCString str

mozEmbedGetTitle :: MozEmbedClass m => m -> IO String
mozEmbedGetTitle m =
  do
   str <- {#call moz_embed_get_title#} (toMozEmbed m)
   peekCString str

mozEmbedGetLocation :: MozEmbedClass m => m -> IO String
mozEmbedGetLocation m =
  do
   str <- {#call moz_embed_get_location#} (toMozEmbed m)
   peekCString str

mozEmbedCanGoBack :: MozEmbedClass m => m -> IO Bool
mozEmbedCanGoBack m =
  liftM toBool $
   {#call moz_embed_can_go_back#} (toMozEmbed m)

mozEmbedCanGoForward :: MozEmbedClass m => m -> IO Bool
mozEmbedCanGoForward m =
  liftM toBool $
   {#call moz_embed_can_go_forward#} (toMozEmbed m)

mozEmbedPushStartup :: IO ()
mozEmbedPushStartup =
  {#call moz_embed_push_startup#}

mozEmbedPopStartup :: IO ()
mozEmbedPopStartup =
  {#call moz_embed_pop_startup#}

{-
void         gtk_moz_embed_open_stream      (GtkMozEmbed *embed,
					     const char *base_uri,
					     const char *mime_type);
void         gtk_moz_embed_append_data      (GtkMozEmbed *embed,
					     const char *data, guint32 len);
void         gtk_moz_embed_close_stream     (GtkMozEmbed *embed);
-}

mozEmbedOpenStream :: MozEmbedClass m => m -> String -> String -> IO ()
mozEmbedOpenStream m baseURI mimeType =
  withCString baseURI  $ \ basePtr ->
  withCString mimeType $ \ mtPtr ->
  {#call gtk_moz_embed_open_stream#} (toMozEmbed m) basePtr mtPtr

mozEmbedAppendDataInternal :: MozEmbedClass m => m -> String -> IO ()
mozEmbedAppendDataInternal m contents =
--  newCStringLen (toUTF contents) >>= \ (dataPtr,len) ->
  withUTFStringLen contents $ \ (dataPtr,len) ->      -- alloca discouraged?
  let len' = fromIntegral len in
  {#call gtk_moz_embed_append_data#} (toMozEmbed m) dataPtr len'
--  >> free dataPtr

mozEmbedCloseStream :: MozEmbedClass m => m -> IO ()
mozEmbedCloseStream m =
  {#call gtk_moz_embed_close_stream#} (toMozEmbed m)

mozEmbedAppendData :: MozEmbedClass m => m -> String -> IO ()
mozEmbedAppendData m contents =
  mapM_ (mozEmbedAppendDataInternal m) (chunks 32768 contents)

mozEmbedRenderData :: MozEmbedClass m => m -> String -> String -> String -> IO ()
mozEmbedRenderData m contents baseURI mimeType = do
  mozEmbedOpenStream m baseURI mimeType
  mozEmbedAppendData m contents
  mozEmbedCloseStream m

chunks :: Int -> [a] -> [[a]]
chunks n [] = []
chunks n xs = let (ys, zs) = splitAt n xs in ys : chunks n zs

{-
void         gtk_moz_embed_render_data      (GtkMozEmbed *embed,
                                             const char *data,
                                             guint32 len,
                                             const char *base_uri,
                                             const char *mime_type)
-}
--  -- mozEmbedRenderDataInternal does not work for len' > 2^16
mozEmbedRenderDataInternal :: MozEmbedClass m => m -> String -> String -> String -> IO ()
mozEmbedRenderDataInternal m contents baseURI mimeType =
--  newCStringLen (toUTF contents) >>= \ (dataPtr,len) ->
  withUTFStringLen contents $ \ (dataPtr,len) ->      -- alloca discouraged
  let len' = fromIntegral len in
--  hPutStrLn stderr ("mozEmbedRenderData: " ++ shows len' " bytes") >>= \ _ ->
  withCString baseURI  $ \ basePrt ->
  withCString mimeType $ \ mtPtr ->
  {#call gtk_moz_embed_render_data#} (toMozEmbed m) dataPtr len' basePrt mtPtr
--  >> free dataPtr

{-
struct _GtkMozEmbedClass
{
  [...]
  gint (* open_uri)            (GtkMozEmbed *embed, const char *aURI);
  [...]
}
-}

onOpenURI :: MozEmbedClass m => m -> (String -> IO Bool) -> IO (ConnectId m)
onOpenURI = connect_STRING__BOOL "open_uri" after
 where
-- Specify if the handler is to run before (False) or after (True) the
-- default handler.
  after = False

{-
More signals to investigate:

  gint (* dom_key_down)        (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_key_press)       (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_key_up)          (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_down)      (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_up)        (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_click)     (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_dbl_click) (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_over)      (GtkMozEmbed *embed, gpointer dom_event);
  gint (* dom_mouse_out)       (GtkMozEmbed *embed, gpointer dom_event);

Unfortunateley these are not documented on

http://www.mozilla.org/unix/gtk-embedding.html

-}

onKeyDown, onKeyPress, onKeyUp,
 onMouseDown, onMouseUp, onMouseClick, onMouseDoubleClick,
 onMouseOver, onMouseOut
 :: (Num n, Integral n, MozEmbedClass m)
 => m -> (Ptr a -> IO n) -> IO (ConnectId m)
onKeyDown          = connect_PTR__INT "dom_key_down" False
onKeyPress         = connect_PTR__INT "dom_key_press" False
onKeyUp            = connect_PTR__INT "dom_key_up" False
onMouseDown        = connect_PTR__INT "dom_mouse_down" False
onMouseUp          = connect_PTR__INT "dom_mouse_up" False
onMouseClick       = connect_PTR__INT "dom_mouse_click" False
onMouseDoubleClick = connect_PTR__INT "dom_mouse_dbl_click" False
onMouseOver        = connect_PTR__INT "dom_mouse_over" False
onMouseOut         = connect_PTR__INT "dom_mouse_out" False


gstreamer: M.S.G.Core.Caps: document everything; code cleanups, remove capsMerge and capsAppend; add capsCopyNth

--  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)
--
--  A structure describing sets of media formats.
module Media.Streaming.GStreamer.Core.Caps (

-- * Detail
  -- | 'Caps' (short for /capabilities/) are lightweight objects
  --   describing media types. They are composed of arrays of
  --   'Structure's.
  --
  --   'Caps' are exposed on 'PadTemplate's to describe all the
  --   possible types a given 'Pad' can handle. They are also stored
  --   in the 'Registry' along with the description of an 'Element'.
  --
  --   'Caps' can be retrieved from an 'Element'\'s 'Pad's using the
  --   'padGetCaps' function. The returned 'Caps' describes the possible
  --   types that the pad can handle or produce at runtime.
  --
  --   'Caps' are also attached to 'Buffers' to describe the type of
  --   the contained data using the function 'bufferSetCaps'. 'Caps'
  --   attached to a buffer allow for format negotiation upstream and
  --   downstream.
  --
  --   'Caps' are /fixed/ when they have no properties with ranges or
  --   lists. Use 'capsIsFixed' to test for fixed caps. Only fixed
  --   caps may be set on a 'Pad' or 'Buffer'.

-- * Types
  Caps,
  capsNone,
  capsAny,

-- * Caps Operations
  capsSize,
  capsGetStructure,
  capsIsEmpty,
  capsIsFixed,
  capsIsEqual,
  capsIsEqualFixed,
  capsIsAlwaysCompatible,
  capsIsSubset,
  capsIntersect,
  capsUnion,
  capsSubtract,
  capsNormalize,
  capsFromString,
  capsToString,

-- * Caps Mutation
  CapsM,
  capsCreate,
  capsModify,
  capsAppendStructure,
  capsMergeStructure,
  capsRemoveStructure,
  capsTruncate

  ) where

{# context lib = "gstreamer" prefix = "gst" #}

import Control.Monad (liftM)
import Control.Monad.Reader
import System.Glib.FFI
import System.Glib.UTFString
{#import Media.Streaming.GStreamer.Core.Types#}

-- | A 'Caps' that represents an undefined media type.
capsNone :: Caps
capsNone =
    unsafePerformIO $ {# call caps_new_empty #} >>= takeCaps

-- | A 'Caps' that represents all possible media types.
capsAny :: Caps
capsAny =
    unsafePerformIO $ {# call caps_new_any #} >>= takeCaps

-- | Returns the number of structures contained in the 'Caps'.
capsSize :: Caps
         -> Word
capsSize caps =
    fromIntegral $ unsafePerformIO $ {# call caps_get_size #} caps

-- | Returns the 'Structure' at the given index.
capsGetStructure :: Caps
                 -> Word
                 -> Maybe Structure
capsGetStructure caps index =
    unsafePerformIO $
        {# call caps_get_structure #} caps (fromIntegral index) >>=
            maybePeek peekStructure

-- | Returns a new 'Caps' containing only the 'Structure' at the given
--   index of the caps.
capsCopyNth :: Caps
            -> Word
            -> Maybe Caps
capsCopyNth caps index =
    unsafePerformIO $
        {# call caps_copy_nth #} caps (fromIntegral index) >>=
            maybePeek takeCaps

-- | Returns 'True' if the caps represents no media formats.
capsIsEmpty :: Caps
            -> Bool
capsIsEmpty caps =
    toBool $ unsafePerformIO $
        {# call caps_is_empty #} caps

-- | Returns 'True' if the caps is fixed.
capsIsFixed :: Caps
            -> Bool
capsIsFixed caps =
    toBool $ unsafePerformIO $
        {# call caps_is_fixed #} caps

-- | Returns 'True' if the caps represent the same set of capabilities.
capsIsEqual :: Caps
            -> Caps
            -> Bool
capsIsEqual caps1 caps2 =
    toBool $ unsafePerformIO $
        {# call caps_is_equal #} caps1 caps2

instance Eq Caps where
    (==) = capsIsEqual

-- | Returns 'True' if the caps are equal.  The caps must both be
--   fixed.
capsIsEqualFixed :: Caps
                 -> Caps
                 -> Bool
capsIsEqualFixed caps1 caps2 =
    toBool $ unsafePerformIO $
        {# call caps_is_equal_fixed #} caps1 caps2

-- | Returns 'True' if every media format in the first caps is also
--   contained by the second. That is, the first is a subset of the
--   second.
capsIsAlwaysCompatible :: Caps
                       -> Caps
                       -> Bool
capsIsAlwaysCompatible caps1 caps2 =
    toBool $ unsafePerformIO $
        {# call caps_is_always_compatible #} caps1 caps2

-- | Returns 'True' if all caps represented by the first argument are
--   also represented by the second.
--
--   This function does not work reliably if optional properties for
--   caps are included on one caps and omitted on the other.
capsIsSubset :: Caps
             -> Caps
             -> Bool
capsIsSubset caps1 caps2 =
    toBool $ unsafePerformIO $
        {# call caps_is_subset #} caps1 caps2

-- | Creates a new caps containing all the formats that are common to
--   both of the caps.
capsIntersect :: Caps
              -> Caps
              -> Caps
capsIntersect caps1 caps2 =
    unsafePerformIO $
        {# call caps_intersect #} caps1 caps2 >>=
            takeCaps

-- | Creates a new caps containing all the formats that are common to
--   either of the caps. If either of the structures are equivalient
--   to 'capsAny', the result will be 'capsAny'.
capsUnion :: Caps
          -> Caps
          -> Caps
capsUnion caps1 caps2 =
    unsafePerformIO $
        {# call caps_union #} caps1 caps2 >>=
            takeCaps

-- | Creates a new caps containing all the formats that are in the
--   first but not the second.
capsSubtract :: Caps
             -> Caps
             -> Caps
capsSubtract caps1 caps2 =
    unsafePerformIO $
        {# call caps_subtract #} caps1 caps2 >>=
            takeCaps

-- | Creates a new caps that represents the same set of formats as the
--   argument, but that contains no lists.
capsNormalize :: Caps
              -> Caps
capsNormalize caps =
    unsafePerformIO $
        {# call caps_normalize #} caps >>= takeCaps

-- | Converts the argument to a string representation. The string can
--   be converted back to a caps using 'capsFromString'.
capsToString :: Caps
             -> String
capsToString caps =
    unsafePerformIO $
        {# call caps_to_string #} caps >>= readUTFString

-- | Read a caps from a string.
capsFromString :: String
               -> Maybe Caps
capsFromString string =
    unsafePerformIO $
        withUTFString string {# call caps_from_string #} >>=
            maybePeek takeCaps

-- | A 'Monad' for sequencing modifications to a 'Caps'.
newtype CapsM a =
    CapsM (ReaderT (Ptr Caps) IO a)
    deriving (Functor, Monad)

askCapsPtr :: CapsM (Ptr Caps)
askCapsPtr = CapsM $ ask

marshalCapsModify :: IO (Ptr Caps)
                  -> CapsM a
                  -> (Caps, a)
marshalCapsModify mkCaps (CapsM action) =
    unsafePerformIO $
        do ptr <- mkCaps
           result <- runReaderT action ptr
           caps <- takeCaps ptr
           return (caps, result)

-- | Create a caps and mutate it according to the given action.
capsCreate :: CapsM a
           -> (Caps, a)
capsCreate action =
    marshalCapsModify
        {# call caps_new_empty #}
        action

-- | Copy a caps and mutate it according to the given action.
capsModify :: Caps
           -> CapsM a
           -> (Caps, a)
capsModify caps action =
    marshalCapsModify ({# call caps_copy #} caps) action

-- | Append the given structure to the current caps.
capsAppendStructure :: Structure
                    -> CapsM ()
capsAppendStructure structure = do
  capsPtr <- askCapsPtr
  CapsM $ liftIO $ withStructure structure $ \structurePtr ->
      do structurePtr' <- gst_structure_copy structurePtr
         gst_caps_append_structure capsPtr structurePtr
  where _ = {# call caps_append_structure #}
        _ = {# call structure_copy #}

-- | Append the structure to the current caps, if it is not already
--   expressed by the caps.
capsMergeStructure :: Structure
                   -> CapsM ()
capsMergeStructure structure = do
  capsPtr <- askCapsPtr
  CapsM $ liftIO $ withStructure structure $ \structurePtr ->
      do structurePtr' <- gst_structure_copy structurePtr
         gst_caps_merge_structure capsPtr structurePtr
  where _ = {# call caps_merge_structure #}
        _ = {# call structure_copy #}

-- | Removes the structure at the given index from the current caps.
capsRemoveStructure :: Word
                    -> CapsM ()
capsRemoveStructure idx = do
  capsPtr <- askCapsPtr
  CapsM $ liftIO $ gst_caps_remove_structure capsPtr $ fromIntegral idx
  where _ = {# call caps_remove_structure #}

-- | Discard all but the first structure from the current caps.
capsTruncate :: CapsM ()
capsTruncate = do
  capsPtr <- askCapsPtr
  CapsM $ liftIO $ gst_caps_truncate capsPtr
  where _ = {# call caps_truncate #}

--  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)
module Media.Streaming.GStreamer.Core.Caps (

  Caps,
  capsNone,
  capsAny,
  capsSize,
  capsGetStructure,
  capsIsEmpty,
  capsIsFixed,
  capsIsEqual,
  capsIsEqualFixed,
  capsIsAlwaysCompatible,
  capsIsSubset,
  capsIntersect,
  capsUnion,
  capsSubtract,
  capsNormalize,
  capsFromString,
  capsToString,

  CapsM,
  capsCreate,
  capsModify,
  capsAppend,
  capsMerge,
  capsAppendStructure,
  capsMergeStructure,
  capsRemoveStructure,
  capsTruncate

  ) where

{# context lib = "gstreamer" prefix = "gst" #}

import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.UTFString
{#import Media.Streaming.GStreamer.Core.Types#}

capsNone :: Caps
capsNone =
    unsafePerformIO $ {# call caps_new_empty #} >>= takeCaps

capsAny :: Caps
capsAny =
    unsafePerformIO $ {# call caps_new_any #} >>= takeCaps

capsSize :: Caps
         -> Word
capsSize caps =
    fromIntegral $ unsafePerformIO $ {# call caps_get_size #} caps

capsGetStructure :: Caps
                 -> Word
                 -> Maybe Structure
capsGetStructure caps index =
    unsafePerformIO $
        {# call caps_get_structure #} caps (fromIntegral index) >>=
            maybePeek peekStructure

capsIsEmpty :: Caps
            -> Bool
capsIsEmpty caps =
    toBool $ unsafePerformIO $
        {# call caps_is_empty #} caps

capsIsFixed :: Caps
            -> Bool
capsIsFixed caps =
    toBool $ unsafePerformIO $
        {# call caps_is_fixed #} caps

capsIsEqual :: Caps
            -> Caps
            -> Bool
capsIsEqual caps1 caps2 =
    toBool $ unsafePerformIO $
        {# call caps_is_equal #} caps1 caps2

instance Eq Caps where
    (==) = capsIsEqual

capsIsEqualFixed :: Caps
                 -> Caps
                 -> Bool
capsIsEqualFixed caps1 caps2 =
    toBool $ unsafePerformIO $
        {# call caps_is_equal_fixed #} caps1 caps2

capsIsAlwaysCompatible :: Caps
                       -> Caps
                       -> Bool
capsIsAlwaysCompatible caps1 caps2 =
    toBool $ unsafePerformIO $
        {# call caps_is_always_compatible #} caps1 caps2

capsIsSubset :: Caps
             -> Caps
             -> Bool
capsIsSubset caps1 caps2 =
    toBool $ unsafePerformIO $
        {# call caps_is_subset #} caps1 caps2

capsIntersect :: Caps
             -> Caps
             -> Caps
capsIntersect caps1 caps2 =
    unsafePerformIO $
        {# call caps_intersect #} caps1 caps2 >>=
            takeCaps

capsUnion :: Caps
          -> Caps
          -> Caps
capsUnion caps1 caps2 =
    unsafePerformIO $
        {# call caps_union #} caps1 caps2 >>=
            takeCaps

capsSubtract :: Caps
             -> Caps
             -> Caps
capsSubtract caps1 caps2 =
    unsafePerformIO $
        {# call caps_subtract #} caps1 caps2 >>=
            takeCaps

capsNormalize :: Caps
              -> Caps
capsNormalize caps =
    unsafePerformIO $
        {# call caps_normalize #} caps >>= takeCaps

capsToString :: Caps
             -> String
capsToString caps =
    unsafePerformIO $
        {# call caps_to_string #} caps >>= readUTFString

capsFromString :: String
               -> Caps
capsFromString string =
    unsafePerformIO $
        withUTFString string {# call caps_from_string #} >>=
            takeCaps

newtype CapsM a = CapsM (CapsMRep a)
type CapsMRep a = (Caps -> IO a)

instance Monad CapsM where
    (CapsM aM) >>= fbM =
        CapsM $ \caps ->
            do a <- aM caps
               let CapsM bM = fbM a
               bM caps
    return a = CapsM $ const $ return a

marshalCapsModify :: IO (Ptr Caps)
                  -> CapsM a
                  -> (Caps, a)
marshalCapsModify mkCaps (CapsM action) =
    unsafePerformIO $
        do ptr <- mkCaps
           caps <- liftM Caps $ newForeignPtr_ ptr
           result <- action caps
           caps' <- takeCaps ptr
           return (caps', result)

capsCreate :: CapsM a
           -> (Caps, a)
capsCreate action =
    marshalCapsModify
        {# call caps_new_empty #}
        action

capsModify :: Caps
           -> CapsM a
           -> (Caps, a)
capsModify caps action =
    marshalCapsModify
        ({# call caps_copy #} caps)
        action

capsAppend :: Caps
           -> CapsM ()
capsAppend caps2 =
    CapsM $ \caps1 ->
        {# call caps_copy #} caps2 >>= takeCaps >>=
            {# call caps_append #} caps1

capsMerge :: Caps
          -> CapsM ()
capsMerge caps2 =
    CapsM $ \caps1 ->
        {# call caps_copy #} caps2 >>= takeCaps >>=
            {# call caps_merge #} caps1

capsAppendStructure :: Structure
                    -> CapsM ()
capsAppendStructure structure =
    CapsM $ \caps ->
        giveStructure structure $
            {# call caps_append_structure #} caps

capsMergeStructure :: Structure
                   -> CapsM ()
capsMergeStructure structure =
    CapsM $ \caps ->
        giveStructure structure $
            {# call caps_merge_structure #} caps

capsRemoveStructure :: Word
                    -> CapsM ()
capsRemoveStructure idx =
    CapsM $ \caps ->
        {# call caps_remove_structure #} caps $ fromIntegral idx

capsTruncate :: CapsM ()
capsTruncate =
    CapsM {# call caps_truncate #}