-- GENERATED by C->Haskell Compiler, version 0.16.0 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Xine/Foreign.chs" #-}{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wwarn #-}

-- |
-- Module      : Xine.Foreign
-- Copyright   : (c) Joachim Fasting 2010
-- License     : LGPL (see COPYING)
-- Maintainer  : Joachim Fasting <joachim.fasting@gmail.com>
-- Stability   : unstable
-- Portability : not portable
--
-- A simple binding to xine-lib. Low-level bindings.
-- Made for xine-lib version 1.1.18.1

module Xine.Foreign (
    -- * Version information
    xine_get_version_string, xine_get_version, xine_check_version,
    -- * Global engine handling
    Engine, AudioPort, VideoPort, VisualType(..),
    xine_new, xine_init, xine_open_audio_driver, xine_open_video_driver,
    xine_close_audio_driver, xine_close_video_driver, xine_exit,
    -- * Stream handling
    Stream, StreamParam(..), Speed(..), NormalSpeed(..), Zoom(..),
    AspectRatio(..), DemuxStrategy(..), Verbosity(..), MRL, EngineParam(..),
    Affection(..), TrickMode(..),
    xine_stream_new, xine_stream_master_slave, xine_open, xine_play,
    xine_dispose, xine_eject,
    xine_trick_mode, xine_stop, xine_close, xine_engine_set_param,
    xine_engine_get_param, xine_set_param, xine_get_param,
    -- * Information retrieval
    EngineStatus(..), XineError(..),
    xine_get_error, xine_get_status,
    xine_get_audio_lang, xine_get_spu_lang,
    xine_get_pos_length,
    InfoType(..), MetaType(..),
    xine_get_stream_info, xine_get_meta_info
    ) where

import Control.Monad (liftM)
import Data.Bits
import Foreign
import Foreign.C

------------------------------------------------------------------------------
-- Marshalling helpers
------------------------------------------------------------------------------

cint2bool :: CInt -> Bool
cint2bool = (/= 0)
{-# INLINE cint2bool #-}

int2cint :: Int -> CInt
int2cint = fromIntegral
{-# INLINE int2cint #-}

cint2int :: CInt -> Int
cint2int = fromIntegral
{-# INLINE cint2int #-}

cuint2int :: CUInt -> Int
cuint2int = fromIntegral
{-# INLINE cuint2int #-}

cint2enum :: Enum a => CInt -> a
cint2enum = toEnum . cint2int
{-# INLINE cint2enum #-}

enum2cint :: Enum a => a -> CInt
enum2cint = int2cint . fromEnum
{-# INLINE enum2cint #-}

peekInt :: Ptr CInt -> IO Int
peekInt = liftM cint2int . peek
{-# INLINE peekInt #-}

-- For pointers which may be NULL.
maybeForeignPtr_ c x | x == nullPtr = return Nothing
                     | otherwise    = (Just . c) `liftM` newForeignPtr_ x

-- Handle strings which may be NULL.
withMaybeString :: Maybe String -> (CString -> IO a) -> IO a
withMaybeString Nothing f  = f nullPtr
withMaybeString (Just s) f = withCString s f

------------------------------------------------------------------------------
-- Foreign interface
------------------------------------------------------------------------------


-- Define the name of the dynamic library that has to be loaded before any of
-- the external C functions may be invoked.
-- The prefix declaration allows us to refer to identifiers while omitting the
-- prefix. Prefix matching is case insensitive and any underscore characters
-- between the prefix and the stem of the identifiers are also removed.

{-# LINE 98 "./Xine/Foreign.chs" #-}

------------------------------------------------------------------------------
-- Version information
------------------------------------------------------------------------------

-- For conditional compilation depending on the xine-lib version

-- | Get xine-lib version string.
--
-- Header declaration:
--
-- const char *xine_get_version_string (void)
xine_get_version_string :: String
xine_get_version_string =
  unsafePerformIO $
  let {res = xine_get_version_string'_} in
  peekCString res >>= \res' ->
  return (res')
{-# LINE 112 "./Xine/Foreign.chs" #-}

-- | Get version as a triple: major, minor, sub
--
-- Header declaration:
--
-- void xine_get_version (int *major, int *minor, int *sub)
xine_get_version :: (Int, Int, Int)
xine_get_version =
  unsafePerformIO $
  alloca $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  let {res = xine_get_version'_ a1' a2' a3'} in
  peekInt a1'>>= \a1'' -> 
  peekInt a2'>>= \a2'' -> 
  peekInt a3'>>= \a3'' -> 
  return (a1'', a2'', a3'')
{-# LINE 122 "./Xine/Foreign.chs" #-}

-- | Compare given version to xine-lib version (major, minor, sub).
--
-- Header declaration:
--
-- int xine_check_version (int major, int minor, int sub)
--
-- returns 1 if compatible, 0 otherwise.
xine_check_version :: Int -> Int -> Int -> Bool
xine_check_version a1 a2 a3 =
  let {a1' = int2cint a1} in 
  let {a2' = int2cint a2} in 
  let {a3' = int2cint a3} in 
  let {res = xine_check_version'_ a1' a2' a3'} in
  let {res' = cint2bool res} in
  (res')
{-# LINE 134 "./Xine/Foreign.chs" #-}

------------------------------------------------------------------------------
-- Global engine handling
------------------------------------------------------------------------------

-- | An opaque type, never dereferenced on the Haskell side
-- XXX: document me
newtype Engine = Engine (ForeignPtr (Engine))
withEngine (Engine fptr) = withForeignPtr fptr
{-# LINE 142 "./Xine/Foreign.chs" #-}

peekEngine = liftM Engine . newForeignPtr_
{-# INLINE peekEngine #-}

-- | Valid visual types
data VisualType = None
                | X11
                | X11_2
                | AA
                | FB
                | GTK
                | DFB
                | PM
                | DirectX
                | CACA
                | MacOSX
                | XCB
                | Raw
                
instance Enum VisualType where
  fromEnum None = 0
  fromEnum X11 = 1
  fromEnum X11_2 = 10
  fromEnum AA = 2
  fromEnum FB = 3
  fromEnum GTK = 4
  fromEnum DFB = 5
  fromEnum PM = 6
  fromEnum DirectX = 7
  fromEnum CACA = 8
  fromEnum MacOSX = 9
  fromEnum XCB = 11
  fromEnum Raw = 12

  toEnum 0 = None
  toEnum 1 = X11
  toEnum 10 = X11_2
  toEnum 2 = AA
  toEnum 3 = FB
  toEnum 4 = GTK
  toEnum 5 = DFB
  toEnum 6 = PM
  toEnum 7 = DirectX
  toEnum 8 = CACA
  toEnum 9 = MacOSX
  toEnum 11 = XCB
  toEnum 12 = Raw
  toEnum unmatched = error ("VisualType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 161 "./Xine/Foreign.chs" #-}

deriving instance Eq VisualType

-- | Pre-init the xine engine.
--
-- Header declaration:
--
-- xine_t *xine_new (void)
xine_new :: IO (Engine)
xine_new =
  xine_new'_ >>= \res ->
  peekEngine res >>= \res' ->
  return (res')
{-# LINE 170 "./Xine/Foreign.chs" #-}

-- | Post-init the xine engine.
--
-- Header declaration:
--
-- void xine_init (xine_t *self)
xine_init :: Engine -> IO ()
xine_init a1 =
  withEngine a1 $ \a1' -> 
  xine_init'_ a1' >>= \res ->
  return ()
{-# LINE 177 "./Xine/Foreign.chs" #-}

-- XXX: just a hack. We really want to be able to pass custom structs to
-- functions. See 'xine_open_audio_driver'.
newtype Data = Data (Ptr Data)

withData f = f nullPtr

-- | An opaque type, never dereferenced on the Haskell side
-- XXX: document me
newtype AudioPort = AudioPort (ForeignPtr (AudioPort))
withAudioPort (AudioPort fptr) = withForeignPtr fptr
{-# LINE 187 "./Xine/Foreign.chs" #-}

peekAudioPort = maybeForeignPtr_ AudioPort
{-# INLINE peekAudioPort #-}

-- | Initialise audio driver.
--
-- Header declaration:
--
-- xine_audio_port_t *xine_open_audio_driver (xine_t *self, const char *id,
--                        void *data)
--
-- id: identifier of the driver, may be NULL for auto-detection
--
-- data: special data struct for ui/driver communication
--
-- May return NULL if the driver failed to load.
xine_open_audio_driver :: Engine -> (Maybe String) -> IO ((Maybe AudioPort))
xine_open_audio_driver a1 a2 =
  withEngine a1 $ \a1' -> 
  withMaybeString a2 $ \a2' -> 
  withData $ \a3' -> 
  xine_open_audio_driver'_ a1' a2' a3' >>= \res ->
  peekAudioPort res >>= \res' ->
  return (res')
{-# LINE 207 "./Xine/Foreign.chs" #-}

-- | An opaque type, never dereferenced on the Haskell side
-- XXX: document me
newtype VideoPort = VideoPort (ForeignPtr (VideoPort))
withVideoPort (VideoPort fptr) = withForeignPtr fptr
{-# LINE 211 "./Xine/Foreign.chs" #-}

peekVideoPort = maybeForeignPtr_ VideoPort
{-# INLINE peekVideoPort #-}

-- | Initialise video driver.
--
-- Header declaration:
--
-- xine_video_port_t *xine_open_video_driver (xine_t *self, const char *id,
--                        int visual, void *data)
--
-- id: identifier of the driver, may be NULL for auto-detection
--
-- data: special data struct for ui/driver communication
--
-- visual : video driver flavor selector
--
-- May return NULL if the driver failed to load.
xine_open_video_driver :: Engine -> (Maybe String) -> VisualType -> IO ((Maybe VideoPort))
xine_open_video_driver a1 a2 a3 =
  withEngine a1 $ \a1' -> 
  withMaybeString a2 $ \a2' -> 
  let {a3' = enum2cint a3} in 
  withData $ \a4' -> 
  xine_open_video_driver'_ a1' a2' a3' a4' >>= \res ->
  peekVideoPort res >>= \res' ->
  return (res')
{-# LINE 234 "./Xine/Foreign.chs" #-}

-- | Close audio port.
--
-- Header declaration:
--
-- void xine_close_audio_driver (xine_t *self, xine_audio_port_t *driver)
xine_close_audio_driver :: Engine -> AudioPort -> IO ()
xine_close_audio_driver a1 a2 =
  withEngine a1 $ \a1' -> 
  withAudioPort a2 $ \a2' -> 
  xine_close_audio_driver'_ a1' a2' >>= \res ->
  return ()
{-# LINE 243 "./Xine/Foreign.chs" #-}

-- | Close video port.
--
-- Header declaration:
--
-- void xine_close_video_driver (xine_t *self, xine_video_port_t *driver)
xine_close_video_driver :: Engine -> VideoPort -> IO ()
xine_close_video_driver a1 a2 =
  withEngine a1 $ \a1' -> 
  withVideoPort a2 $ \a2' -> 
  xine_close_video_driver'_ a1' a2' >>= \res ->
  return ()
{-# LINE 252 "./Xine/Foreign.chs" #-}

-- | Free all resources, close all plugins, close engine.
--
-- Header declaration:
--
-- void xine_exit (xine_t *self)
xine_exit :: Engine -> IO ()
xine_exit a1 =
  withEngine a1 $ \a1' -> 
  xine_exit'_ a1' >>= \res ->
  return ()
{-# LINE 259 "./Xine/Foreign.chs" #-}

------------------------------------------------------------------------------
-- Stream handling
------------------------------------------------------------------------------

-- | An opaque type, never dereferenced on the Haskell side
newtype Stream = Stream (ForeignPtr (Stream))
withStream (Stream fptr) = withForeignPtr fptr
{-# LINE 266 "./Xine/Foreign.chs" #-}

peekStream = maybeForeignPtr_ Stream
{-# INLINE peekStream #-}

-- | Media Resource Locator.
-- Describes the media to read from. Valid MRLs may be plain file names or
-- one of the following:
--
-- * Filesystem:
--
-- file:\<path\>
--
-- fifo:\<path\>
--
-- stdin:\/
--
-- * CD and DVD:
--
-- dvd:\/[device_name][\/title[.part]]
--
-- dvd:\/DVD_image_file[\/title[.part]]
--
-- dvd:\/DVD_directory[\/title[.part]]
--
-- vcd:\/\/[CD_image_or_device_name][\@[letter]number]
--
-- vcdo:\/\/track_number
--
-- cdda:\/[device][\/track_number]
--
-- * Video devices:
--
-- v4l:\/\/[tuner_device\/frequency
--
-- v4l2:\/\/tuner_device
--
-- dvb:\/\/channel_number
--
-- dvb:\/\/channel_name
--
-- dvbc:\/\/channel_name:tuning_parameters
--
-- dvbs:\/\/channel_name:tuning_parameters
--
-- dvbt:\/\/channel_name:tuning_parameters
--
-- dvba:\/\/channel_name:tuning_parameters
--
-- pvr:\/tmp_files_path!saved_files_path!max_page_age
--
-- * Network:
--
-- http:\/\/host
--
-- tcp:\/\/host[:port]
--
-- udp:\/\/host[:port[?iface=interface]]
--
-- rtp:\/\/host[:port[?iface=interface]]
--
-- smb:\/\/
--
-- mms:\/\/host
--
-- pnm:\/\/host
--
-- rtsp:\/\/host
type MRL = String

-- | Engine parameter enumeration.
data EngineParam = EngineVerbosity
                 
instance Enum EngineParam where
  fromEnum EngineVerbosity = 1

  toEnum 1 = EngineVerbosity
  toEnum unmatched = error ("EngineParam.toEnum: Cannot match " ++ show unmatched)

{-# LINE 338 "./Xine/Foreign.chs" #-}

-- | Stream parameter enumeration.
data StreamParam = Speed
                 | AvOffset
                 | AudioChannelLogical
                 | SpuChannel
                 | AudioVolume
                 | AudioMute
                 | AudioComprLevel
                 | AudioReportLevel
                 | Verbosity
                 | SpuOffset
                 | IgnoreVideo
                 | IgnoreAudio
                 | BroadcasterPort
                 | MetronomPrebuffer
                 | Eq30Hz
                 | Eq60Hz
                 | Eq125Hz
                 | Eq500Hz
                 | Eq1000Hz
                 | Eq2000Hz
                 | Eq4000Hz
                 | Eq8000Hz
                 | Eq16000Hz
                 | AudioCloseDevice
                 | AmpMute
                 | FineSpeed
                 | EarlyFinishedEvent
                 | GaplessSwitch
                 | DelayFinishedEvent
                 | Deinterlace
                 | AspectRatio
                 | Hue
                 | Saturation
                 | Contrast
                 | Brightness
                 | ZoomX
                 | ZoomY
                 | PanScan
                 | TvMode
                 | WindowWidth
                 | WindowHeight
                 | CropLeft
                 | CropRight
                 | CropTop
                 | CropBottom
                 
instance Enum StreamParam where
  fromEnum Speed = 1
  fromEnum AvOffset = 2
  fromEnum AudioChannelLogical = 3
  fromEnum SpuChannel = 4
  fromEnum AudioVolume = 6
  fromEnum AudioMute = 7
  fromEnum AudioComprLevel = 8
  fromEnum AudioReportLevel = 10
  fromEnum Verbosity = 11
  fromEnum SpuOffset = 12
  fromEnum IgnoreVideo = 13
  fromEnum IgnoreAudio = 14
  fromEnum BroadcasterPort = 16
  fromEnum MetronomPrebuffer = 17
  fromEnum Eq30Hz = 18
  fromEnum Eq60Hz = 19
  fromEnum Eq125Hz = 20
  fromEnum Eq500Hz = 22
  fromEnum Eq1000Hz = 23
  fromEnum Eq2000Hz = 24
  fromEnum Eq4000Hz = 25
  fromEnum Eq8000Hz = 26
  fromEnum Eq16000Hz = 27
  fromEnum AudioCloseDevice = 28
  fromEnum AmpMute = 29
  fromEnum FineSpeed = 30
  fromEnum EarlyFinishedEvent = 31
  fromEnum GaplessSwitch = 32
  fromEnum DelayFinishedEvent = 33
  fromEnum Deinterlace = 16777216
  fromEnum AspectRatio = 16777217
  fromEnum Hue = 16777218
  fromEnum Saturation = 16777219
  fromEnum Contrast = 16777220
  fromEnum Brightness = 16777221
  fromEnum ZoomX = 16777224
  fromEnum ZoomY = 16777229
  fromEnum PanScan = 16777225
  fromEnum TvMode = 16777226
  fromEnum WindowWidth = 16777231
  fromEnum WindowHeight = 16777232
  fromEnum CropLeft = 16777248
  fromEnum CropRight = 16777249
  fromEnum CropTop = 16777250
  fromEnum CropBottom = 16777251

  toEnum 1 = Speed
  toEnum 2 = AvOffset
  toEnum 3 = AudioChannelLogical
  toEnum 4 = SpuChannel
  toEnum 6 = AudioVolume
  toEnum 7 = AudioMute
  toEnum 8 = AudioComprLevel
  toEnum 10 = AudioReportLevel
  toEnum 11 = Verbosity
  toEnum 12 = SpuOffset
  toEnum 13 = IgnoreVideo
  toEnum 14 = IgnoreAudio
  toEnum 16 = BroadcasterPort
  toEnum 17 = MetronomPrebuffer
  toEnum 18 = Eq30Hz
  toEnum 19 = Eq60Hz
  toEnum 20 = Eq125Hz
  toEnum 22 = Eq500Hz
  toEnum 23 = Eq1000Hz
  toEnum 24 = Eq2000Hz
  toEnum 25 = Eq4000Hz
  toEnum 26 = Eq8000Hz
  toEnum 27 = Eq16000Hz
  toEnum 28 = AudioCloseDevice
  toEnum 29 = AmpMute
  toEnum 30 = FineSpeed
  toEnum 31 = EarlyFinishedEvent
  toEnum 32 = GaplessSwitch
  toEnum 33 = DelayFinishedEvent
  toEnum 16777216 = Deinterlace
  toEnum 16777217 = AspectRatio
  toEnum 16777218 = Hue
  toEnum 16777219 = Saturation
  toEnum 16777220 = Contrast
  toEnum 16777221 = Brightness
  toEnum 16777224 = ZoomX
  toEnum 16777229 = ZoomY
  toEnum 16777225 = PanScan
  toEnum 16777226 = TvMode
  toEnum 16777231 = WindowWidth
  toEnum 16777232 = WindowHeight
  toEnum 16777248 = CropLeft
  toEnum 16777249 = CropRight
  toEnum 16777250 = CropTop
  toEnum 16777251 = CropBottom
  toEnum unmatched = error ("StreamParam.toEnum: Cannot match " ++ show unmatched)

{-# LINE 387 "./Xine/Foreign.chs" #-}

-- | Values for XINE_PARAM_SPEED parameter.
data Speed = Pause
           | Slow4
           | Slow2
           | Normal
           | Fast2
           | Fast4
           
instance Enum Speed where
  fromEnum Pause = 0
  fromEnum Slow4 = 1
  fromEnum Slow2 = 2
  fromEnum Normal = 4
  fromEnum Fast2 = 8
  fromEnum Fast4 = 16

  toEnum 0 = Pause
  toEnum 1 = Slow4
  toEnum 2 = Slow2
  toEnum 4 = Normal
  toEnum 8 = Fast2
  toEnum 16 = Fast4
  toEnum unmatched = error ("Speed.toEnum: Cannot match " ++ show unmatched)

{-# LINE 397 "./Xine/Foreign.chs" #-}

deriving instance Eq Speed

-- | Value for XINE_PARAM_FINE_SPEED
data NormalSpeed = NormalSpeed
                 
instance Enum NormalSpeed where
  fromEnum NormalSpeed = 1000000

  toEnum 1000000 = NormalSpeed
  toEnum unmatched = error ("NormalSpeed.toEnum: Cannot match " ++ show unmatched)

{-# LINE 403 "./Xine/Foreign.chs" #-}

-- | Values for XINE_PARAM_VO_ZOOM_
data Zoom = ZoomStep
          | ZoomMax
          | ZoomMin
          
instance Enum Zoom where
  fromEnum ZoomStep = 100
  fromEnum ZoomMax = 400
  fromEnum ZoomMin = (-85)

  toEnum 100 = ZoomStep
  toEnum 400 = ZoomMax
  toEnum (-85) = ZoomMin
  toEnum unmatched = error ("Zoom.toEnum: Cannot match " ++ show unmatched)

{-# LINE 409 "./Xine/Foreign.chs" #-}

-- | Values for XINE_PARAM_VO_ASPECT_RATIO
data AspectRatio = AspectAuto
                 | AspectSquare
                 | Aspect43
                 | AspectAnamorphic
                 | AspectDvb
                 | AspectNumRatios
                 
instance Enum AspectRatio where
  fromEnum AspectAuto = 0
  fromEnum AspectSquare = 1
  fromEnum Aspect43 = 2
  fromEnum AspectAnamorphic = 3
  fromEnum AspectDvb = 4
  fromEnum AspectNumRatios = 5

  toEnum 0 = AspectAuto
  toEnum 1 = AspectSquare
  toEnum 2 = Aspect43
  toEnum 3 = AspectAnamorphic
  toEnum 4 = AspectDvb
  toEnum 5 = AspectNumRatios
  toEnum unmatched = error ("AspectRatio.toEnum: Cannot match " ++ show unmatched)

{-# LINE 419 "./Xine/Foreign.chs" #-}

-- | Stream format detection strategies
data DemuxStrategy = DemuxDefault
                   | DemuxRevert
                   | DemuxContent
                   | DemuxExtension
                   
instance Enum DemuxStrategy where
  fromEnum DemuxDefault = 0
  fromEnum DemuxRevert = 1
  fromEnum DemuxContent = 2
  fromEnum DemuxExtension = 3

  toEnum 0 = DemuxDefault
  toEnum 1 = DemuxRevert
  toEnum 2 = DemuxContent
  toEnum 3 = DemuxExtension
  toEnum unmatched = error ("DemuxStrategy.toEnum: Cannot match " ++ show unmatched)

{-# LINE 426 "./Xine/Foreign.chs" #-}

-- | Verbosity setting
data Verbosity = VerbosityNone
               | VerbosityLog
               | VerbosityDebug
               
instance Enum Verbosity where
  fromEnum VerbosityNone = 0
  fromEnum VerbosityLog = 1
  fromEnum VerbosityDebug = 2

  toEnum 0 = VerbosityNone
  toEnum 1 = VerbosityLog
  toEnum 2 = VerbosityDebug
  toEnum unmatched = error ("Verbosity.toEnum: Cannot match " ++ show unmatched)

{-# LINE 432 "./Xine/Foreign.chs" #-}

-- | Create a new stream for media playback.
--
-- Header declaration:
--
-- xine_stream_t *xine_stream_new (xine_t *self,
--     xine_audio_port *ao, xine_video_port_t *vo)
--
-- Returns xine_stream_t* if OK, NULL on error (use 'xine_get_error' for
-- details).
xine_stream_new :: Engine -> AudioPort -> VideoPort -> IO ((Maybe Stream))
xine_stream_new a1 a2 a3 =
  withEngine a1 $ \a1' -> 
  withAudioPort a2 $ \a2' -> 
  withVideoPort a3 $ \a3' -> 
  xine_stream_new'_ a1' a2' a3' >>= \res ->
  peekStream res >>= \res' ->
  return (res')
{-# LINE 446 "./Xine/Foreign.chs" #-}

-- | Make one stream the slave of another.
-- Certain operations on the master stream are also applied to the slave
-- stream.
--
-- Header declaration:
--
-- int xine_stream_master_slave (xine_stream_t *master, xine_stream_t *slave,
--                               int affection)
--
-- returns 1 on success, 0 on failure.
xine_stream_master_slave :: Stream -> Stream -> [Affection] -> IO (Int)
xine_stream_master_slave a1 a2 a3 =
  withStream a1 $ \a1' -> 
  withStream a2 $ \a2' -> 
  let {a3' = combineAffection a3} in 
  xine_stream_master_slave'_ a1' a2' a3' >>= \res ->
  let {res' = cint2int res} in
  return (res')
{-# LINE 461 "./Xine/Foreign.chs" #-}

-- | The affection determines which actions on the master stream
-- are also to be applied to the slave stream. See 'xine_stream_master_slave'.
data Affection = AffectionPlay
               | AffectionStop
               | AffectionSpeed
               
instance Enum Affection where
  fromEnum AffectionPlay = 1
  fromEnum AffectionStop = 2
  fromEnum AffectionSpeed = 4

  toEnum 1 = AffectionPlay
  toEnum 2 = AffectionStop
  toEnum 4 = AffectionSpeed
  toEnum unmatched = error ("Affection.toEnum: Cannot match " ++ show unmatched)

{-# LINE 468 "./Xine/Foreign.chs" #-}

-- | Affections can be ORed together.
combineAffection :: [Affection] -> CInt
combineAffection [] = enum2cint AffectionSpeed
combineAffection xs = foldr1 (.&.) (map enum2cint xs)

-- | Open a stream.
--
-- Header declaration:
--
-- int xine_open (xine_stream_t *stream, const char *mrl)
--
-- Returns 1 if OK, 0 on error (use 'xine_get_error' for details).
xine_open :: Stream -> MRL -> IO (Int)
xine_open a1 a2 =
  withStream a1 $ \a1' -> 
  withCAString a2 $ \a2' -> 
  xine_open'_ a1' a2' >>= \res ->
  let {res' = cint2int res} in
  return (res')
{-# LINE 484 "./Xine/Foreign.chs" #-}

-- | Play a stream from a given position.
--
-- Header declaration:
--
-- int xine_play (xine_stream_t *stream, int start_pos, int start_time)
--
-- Returns 1 if OK, 0 on error (use 'xine_get_error' for details).
xine_play :: Stream -> Int -> Int -> IO (Int)
xine_play a1 a2 a3 =
  withStream a1 $ \a1' -> 
  let {a2' = int2cint a2} in 
  let {a3' = int2cint a3} in 
  xine_play'_ a1' a2' a3' >>= \res ->
  let {res' = cint2int res} in
  return (res')
{-# LINE 496 "./Xine/Foreign.chs" #-}

-- | Set xine to a trick mode for fast forward, backwards playback,
-- low latency seeking.
--
-- Header declaration:
--
-- int xine_trick_mode (xine_stream_t *stream, int mode, int value)
--
-- Returns 1 if OK, 0 on error (use 'xine_get_error' for details).
xine_trick_mode :: Stream -> TrickMode -> Int -> IO (Int)
xine_trick_mode a1 a2 a3 =
  withStream a1 $ \a1' -> 
  let {a2' = enum2cint a2} in 
  let {a3' = int2cint a3} in 
  xine_trick_mode'_ a1' a2' a3' >>= \res ->
  let {res' = cint2int res} in
  return (res')
{-# LINE 509 "./Xine/Foreign.chs" #-}

data TrickMode = TrickOff
               | TrickSeekToPosition
               | TrickSeekToTime
               | TrickFastForward
               | TrickRewind
               
instance Enum TrickMode where
  fromEnum TrickOff = 0
  fromEnum TrickSeekToPosition = 1
  fromEnum TrickSeekToTime = 2
  fromEnum TrickFastForward = 3
  fromEnum TrickRewind = 4

  toEnum 0 = TrickOff
  toEnum 1 = TrickSeekToPosition
  toEnum 2 = TrickSeekToTime
  toEnum 3 = TrickFastForward
  toEnum 4 = TrickRewind
  toEnum unmatched = error ("TrickMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 516 "./Xine/Foreign.chs" #-}

-- | Stop stream playback.
-- The stream stays valid for new 'xine_open' or 'xine_play'.
--
-- Header declaration:
--
-- void xine_stop (xine_stream *stream)
xine_stop :: Stream -> IO ()
xine_stop a1 =
  withStream a1 $ \a1' -> 
  xine_stop'_ a1' >>= \res ->
  return ()
{-# LINE 524 "./Xine/Foreign.chs" #-}

-- | Free all stream-related resources.
-- The stream stays valid for new 'xine_open'.
--
-- Header declaration:
--
-- void xine_close (xine_stream_t *stream)
xine_close :: Stream -> IO ()
xine_close a1 =
  withStream a1 $ \a1' -> 
  xine_close'_ a1' >>= \res ->
  return ()
{-# LINE 532 "./Xine/Foreign.chs" #-}

-- | Ask current input plugin to eject media.
--
-- Header declaration:
--
-- int xine_eject (xine_stream_t *stream)
xine_eject :: Stream -> IO (Int)
xine_eject a1 =
  withStream a1 $ \a1' -> 
  xine_eject'_ a1' >>= \res ->
  let {res' = cint2int res} in
  return (res')
{-# LINE 539 "./Xine/Foreign.chs" #-}

-- | Stop playback, dispose all stream-related resources.
-- The stream is no longer valid after this.
--
-- Header declaration:
--
-- void xine_dispose (xine_stream_t *stream)
xine_dispose :: Stream -> IO ()
xine_dispose a1 =
  withStream a1 $ \a1' -> 
  xine_dispose'_ a1' >>= \res ->
  return ()
{-# LINE 547 "./Xine/Foreign.chs" #-}

-- | Set engine parameter.
--
-- Header declaration:
--
-- void xine_engine_set_param (xine_t *self, int param, int value)
xine_engine_set_param :: Engine -> EngineParam -> Int -> IO ()
xine_engine_set_param a1 a2 a3 =
  withEngine a1 $ \a1' -> 
  let {a2' = enum2cint a2} in 
  let {a3' = int2cint a3} in 
  xine_engine_set_param'_ a1' a2' a3' >>= \res ->
  return ()
{-# LINE 557 "./Xine/Foreign.chs" #-}

-- | Get engine parameter.
--
-- Header declaration:
--
-- int xine_engine_get_param(xine_t *self, int param)
xine_engine_get_param :: Engine -> EngineParam -> IO (Int)
xine_engine_get_param a1 a2 =
  withEngine a1 $ \a1' -> 
  let {a2' = enum2cint a2} in 
  xine_engine_get_param'_ a1' a2' >>= \res ->
  let {res' = cint2int res} in
  return (res')
{-# LINE 566 "./Xine/Foreign.chs" #-}

-- | Set stream parameter.
--
-- Header declaration:
--
-- void xine_set_param (xine_stream_t *stream, int param, int value)
xine_set_param :: (Enum a) => Stream -> StreamParam -> a -> IO ()
xine_set_param a1 a2 a3 =
  withStream a1 $ \a1' -> 
  let {a2' = enum2cint a2} in 
  let {a3' = enum2cint a3} in 
  xine_set_param'_ a1' a2' a3' >>= \res ->
  return ()
{-# LINE 577 "./Xine/Foreign.chs" #-}

-- | Get stream parameter.
--
-- Header declaration:
--
-- int xine_get_param (xine_stream_t *stream, int param)
xine_get_param :: (Enum a) => Stream -> StreamParam -> IO (a)
xine_get_param a1 a2 =
  withStream a1 $ \a1' -> 
  let {a2' = enum2cint a2} in 
  xine_get_param'_ a1' a2' >>= \res ->
  let {res' = cint2enum res} in
  return (res')
{-# LINE 587 "./Xine/Foreign.chs" #-}

------------------------------------------------------------------------------
-- Information retrieval
------------------------------------------------------------------------------

-- | Engine status codes.
data EngineStatus = Idle
                  | Stopped
                  | Playing
                  | Quitting
                  
instance Enum EngineStatus where
  fromEnum Idle = 0
  fromEnum Stopped = 1
  fromEnum Playing = 2
  fromEnum Quitting = 3

  toEnum 0 = Idle
  toEnum 1 = Stopped
  toEnum 2 = Playing
  toEnum 3 = Quitting
  toEnum unmatched = error ("EngineStatus.toEnum: Cannot match " ++ show unmatched)

{-# LINE 598 "./Xine/Foreign.chs" #-}

deriving instance Eq EngineStatus
deriving instance Show EngineStatus

-- | xine error codes.
data XineError = NoError
               | NoInputPlugin
               | NoDemuxPlugin
               | MalformedMrl
               | InputFailed
               
instance Enum XineError where
  fromEnum NoError = 0
  fromEnum NoInputPlugin = 1
  fromEnum NoDemuxPlugin = 2
  fromEnum MalformedMrl = 4
  fromEnum InputFailed = 5

  toEnum 0 = NoError
  toEnum 1 = NoInputPlugin
  toEnum 2 = NoDemuxPlugin
  toEnum 4 = MalformedMrl
  toEnum 5 = InputFailed
  toEnum unmatched = error ("XineError.toEnum: Cannot match " ++ show unmatched)

{-# LINE 609 "./Xine/Foreign.chs" #-}

deriving instance Eq XineError
deriving instance Show XineError

-- | Return last error.
--
-- Header declaration:
--
-- int xine_get_error (xine_stream_t *stream)
xine_get_error :: Stream -> IO (XineError)
xine_get_error a1 =
  withStream a1 $ \a1' -> 
  xine_get_error'_ a1' >>= \res ->
  let {res' = cint2enum res} in
  return (res')
{-# LINE 620 "./Xine/Foreign.chs" #-}

-- | Get current xine engine status.
--
-- int xine_get_status (xine_stream_t *stream)
xine_get_status :: Stream -> IO (EngineStatus)
xine_get_status a1 =
  withStream a1 $ \a1' -> 
  xine_get_status'_ a1' >>= \res ->
  let {res' = cint2enum res} in
  return (res')
{-# LINE 626 "./Xine/Foreign.chs" #-}

-- | Find the audio language of the given channel (use -1 for
-- current channel).
--
-- Header declaration:
--
-- int xine_get_audio_lang (xine_stream_t *stream, int channel,
--                          char *lang)
--
-- lang must point to a buffer of at least XINE_LANG_MAX bytes.
--
-- Returns 1 on success, 0 on failure.
xine_get_audio_lang :: Stream -> Int -> IO (Int, String)
xine_get_audio_lang a1 a2 =
  withStream a1 $ \a1' -> 
  let {a2' = int2cint a2} in 
  allocLangBuf $ \a3' -> 
  xine_get_audio_lang'_ a1' a2' a3' >>= \res ->
  peekCString a3'>>= \a3'' -> 
  let {res' = cint2int res} in
  return (res', a3'')
{-# LINE 642 "./Xine/Foreign.chs" #-}

-- This is a trick to read the #define'd constant XINE_LANG_MAX
data Wrapping = LangMax
              
instance Enum Wrapping where
  fromEnum LangMax = 32

  toEnum 32 = LangMax
  toEnum unmatched = error ("Wrapping.toEnum: Cannot match " ++ show unmatched)

{-# LINE 646 "./Xine/Foreign.chs" #-}

cXINE_LANG_MAX :: Int
cXINE_LANG_MAX = fromEnum LangMax

-- Helper to allocate a language buffer
allocLangBuf = allocaArray0 cXINE_LANG_MAX

-- | Find the spu language of the given channel (use -1 for
-- current channel).
--
-- Header declaration:
--
-- int xine_get_spu_lang (xine_stream_t *stream, int channel,
--                          char *lang)
--
-- lang must point to a buffer of at least XINE_LANG_MAX bytes.
--
-- Returns 1 on success, 0 on failure.
xine_get_spu_lang :: Stream -> Int -> IO (Int, String)
xine_get_spu_lang a1 a2 =
  withStream a1 $ \a1' -> 
  let {a2' = int2cint a2} in 
  allocLangBuf $ \a3' -> 
  xine_get_spu_lang'_ a1' a2' a3' >>= \res ->
  peekCString a3'>>= \a3'' -> 
  let {res' = cint2int res} in
  return (res', a3'')
{-# LINE 668 "./Xine/Foreign.chs" #-}

-- | Get position\/length information.
--
-- Header declaration:
--
-- int xine_get_pos_length (xine_stream_t *stream, int *pos_stream,
--                          int *pos_time, int *length_time)
--
-- Returns 1 on success, 0 on failure.
xine_get_pos_length :: Stream -> IO (Int, Int, Int, Int)
xine_get_pos_length a1 =
  withStream a1 $ \a1' -> 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  alloca $ \a4' -> 
  xine_get_pos_length'_ a1' a2' a3' a4' >>= \res ->
  peekInt a2'>>= \a2'' -> 
  peekInt a3'>>= \a3'' -> 
  peekInt a4'>>= \a4'' -> 
  let {res' = cint2int res} in
  return (res', a2'', a3'', a4'')
{-# LINE 682 "./Xine/Foreign.chs" #-}

-- | Get information about the stream.
--
-- Header declaration:
--
-- int32_t xine_get_stream_info (xine_stream_t *stream, int info)
xine_get_stream_info :: Stream -> InfoType -> IO (Int)
xine_get_stream_info a1 a2 =
  withStream a1 $ \a1' -> 
  let {a2' = enum2cint a2} in 
  xine_get_stream_info'_ a1' a2' >>= \res ->
  let {res' = cuint2int res} in
  return (res')
{-# LINE 691 "./Xine/Foreign.chs" #-}

-- | Get meta information about the stream.
--
-- Header declaration:
--
-- const char *xine_get_meta_info (xine_stream_t *stream, int info)
xine_get_meta_info :: Stream -> MetaType -> IO (String)
xine_get_meta_info a1 a2 =
  withStream a1 $ \a1' -> 
  let {a2' = enum2cint a2} in 
  xine_get_meta_info'_ a1' a2' >>= \res ->
  peekCString res >>= \res' ->
  return (res')
{-# LINE 700 "./Xine/Foreign.chs" #-}

-- | The different kinds of stream information
data InfoType = InfoBitrate
              | InfoSeekable
              | InfoVideoWidth
              | InfoVideoHeight
              | InfoVideoRatio
              | InfoVideoChannels
              | InfoVideoStreams
              | InfoVideoBitrate
              | InfoVideoFourCC
              | InfoVideoHandled
              | InfoFrameDuration
              | InfoAudioChannels
              | InfoAudioBits
              | InfoAudioSamplerate
              | InfoAudioBitrate
              | InfoAudioFourCC
              | InfoAudioHandled
              | InfoHasChapters
              | InfoHasVideo
              | InfoHasAudio
              | InfoIgnoreVideo
              | InfoIgnoreAudio
              | InfoIgnoreSpu
              | InfoVideoHasStill
              | InfoMaxAudioChannel
              | InfoMaxSpuChannel
              | InfoAudioMode
              | InfoSkippedFrames
              | InfoDiscardedFrames
              | InfoVideoAFD
              | InfoDvdTitleNumber
              | InfoDvdTitleCount
              | InfoDvdChapterNumber
              | InfoDvdChapterCount
              | InfoDvdAngleNumber
              | InfoDvdAngleCount
              
instance Enum InfoType where
  fromEnum InfoBitrate = 0
  fromEnum InfoSeekable = 1
  fromEnum InfoVideoWidth = 2
  fromEnum InfoVideoHeight = 3
  fromEnum InfoVideoRatio = 4
  fromEnum InfoVideoChannels = 5
  fromEnum InfoVideoStreams = 6
  fromEnum InfoVideoBitrate = 7
  fromEnum InfoVideoFourCC = 8
  fromEnum InfoVideoHandled = 9
  fromEnum InfoFrameDuration = 10
  fromEnum InfoAudioChannels = 11
  fromEnum InfoAudioBits = 12
  fromEnum InfoAudioSamplerate = 13
  fromEnum InfoAudioBitrate = 14
  fromEnum InfoAudioFourCC = 15
  fromEnum InfoAudioHandled = 16
  fromEnum InfoHasChapters = 17
  fromEnum InfoHasVideo = 18
  fromEnum InfoHasAudio = 19
  fromEnum InfoIgnoreVideo = 20
  fromEnum InfoIgnoreAudio = 21
  fromEnum InfoIgnoreSpu = 22
  fromEnum InfoVideoHasStill = 23
  fromEnum InfoMaxAudioChannel = 24
  fromEnum InfoMaxSpuChannel = 25
  fromEnum InfoAudioMode = 26
  fromEnum InfoSkippedFrames = 27
  fromEnum InfoDiscardedFrames = 28
  fromEnum InfoVideoAFD = 29
  fromEnum InfoDvdTitleNumber = 30
  fromEnum InfoDvdTitleCount = 31
  fromEnum InfoDvdChapterNumber = 32
  fromEnum InfoDvdChapterCount = 33
  fromEnum InfoDvdAngleNumber = 34
  fromEnum InfoDvdAngleCount = 35

  toEnum 0 = InfoBitrate
  toEnum 1 = InfoSeekable
  toEnum 2 = InfoVideoWidth
  toEnum 3 = InfoVideoHeight
  toEnum 4 = InfoVideoRatio
  toEnum 5 = InfoVideoChannels
  toEnum 6 = InfoVideoStreams
  toEnum 7 = InfoVideoBitrate
  toEnum 8 = InfoVideoFourCC
  toEnum 9 = InfoVideoHandled
  toEnum 10 = InfoFrameDuration
  toEnum 11 = InfoAudioChannels
  toEnum 12 = InfoAudioBits
  toEnum 13 = InfoAudioSamplerate
  toEnum 14 = InfoAudioBitrate
  toEnum 15 = InfoAudioFourCC
  toEnum 16 = InfoAudioHandled
  toEnum 17 = InfoHasChapters
  toEnum 18 = InfoHasVideo
  toEnum 19 = InfoHasAudio
  toEnum 20 = InfoIgnoreVideo
  toEnum 21 = InfoIgnoreAudio
  toEnum 22 = InfoIgnoreSpu
  toEnum 23 = InfoVideoHasStill
  toEnum 24 = InfoMaxAudioChannel
  toEnum 25 = InfoMaxSpuChannel
  toEnum 26 = InfoAudioMode
  toEnum 27 = InfoSkippedFrames
  toEnum 28 = InfoDiscardedFrames
  toEnum 29 = InfoVideoAFD
  toEnum 30 = InfoDvdTitleNumber
  toEnum 31 = InfoDvdTitleCount
  toEnum 32 = InfoDvdChapterNumber
  toEnum 33 = InfoDvdChapterCount
  toEnum 34 = InfoDvdAngleNumber
  toEnum 35 = InfoDvdAngleCount
  toEnum unmatched = error ("InfoType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 739 "./Xine/Foreign.chs" #-}

-- | Possible values for InfoVideoAFD
data AFDValue = AFDNotPresent
              | AFDReserved0
              | AFDReserved1
              | AFDBox169Top
              | AFDBox149Top
              | AFDGt169Centre
              | AFDReserved5
              | AFDReserved6
              | AFDReserved7
              | AFDSameAsFrame
              | AFD43Centre
              | AFD169Centre
              | AFD149Centre
              | AFDReserved12
              | AFD43Protect149
              | AFD169Protect149
              | AFD169Protect43
              
instance Enum AFDValue where
  fromEnum AFDNotPresent = (-1)
  fromEnum AFDReserved0 = 0
  fromEnum AFDReserved1 = 1
  fromEnum AFDBox169Top = 2
  fromEnum AFDBox149Top = 3
  fromEnum AFDGt169Centre = 4
  fromEnum AFDReserved5 = 5
  fromEnum AFDReserved6 = 6
  fromEnum AFDReserved7 = 7
  fromEnum AFDSameAsFrame = 8
  fromEnum AFD43Centre = 9
  fromEnum AFD169Centre = 10
  fromEnum AFD149Centre = 11
  fromEnum AFDReserved12 = 12
  fromEnum AFD43Protect149 = 13
  fromEnum AFD169Protect149 = 14
  fromEnum AFD169Protect43 = 15

  toEnum (-1) = AFDNotPresent
  toEnum 0 = AFDReserved0
  toEnum 1 = AFDReserved1
  toEnum 2 = AFDBox169Top
  toEnum 3 = AFDBox149Top
  toEnum 4 = AFDGt169Centre
  toEnum 5 = AFDReserved5
  toEnum 6 = AFDReserved6
  toEnum 7 = AFDReserved7
  toEnum 8 = AFDSameAsFrame
  toEnum 9 = AFD43Centre
  toEnum 10 = AFD169Centre
  toEnum 11 = AFD149Centre
  toEnum 12 = AFDReserved12
  toEnum 13 = AFD43Protect149
  toEnum 14 = AFD169Protect149
  toEnum 15 = AFD169Protect43
  toEnum unmatched = error ("AFDValue.toEnum: Cannot match " ++ show unmatched)

{-# LINE 759 "./Xine/Foreign.chs" #-}

-- | The different kinds of metadata
data MetaType = MetaTitle
              | MetaComment
              | MetaArtist
              | MetaGenre
              | MetaAlbum
              | MetaYear
              | MetaVideoCodec
              | MetaAudioCodec
              | MetaSystemLayer
              | MetaInputPlugin
              | MetaDiscId
              | MetaTrackNumber
              | MetaComposer
              | MetaPublisher
              | MetaLicense
              | MetaArranger
              | MetaLyricist
              | MetaConductor
              | MetaPerformer
              | MetaEnsemble
              | MetaOpus
              | MetaPart
              | MetaPartNumber
              | MetaLocation
              
instance Enum MetaType where
  fromEnum MetaTitle = 0
  fromEnum MetaComment = 1
  fromEnum MetaArtist = 2
  fromEnum MetaGenre = 3
  fromEnum MetaAlbum = 4
  fromEnum MetaYear = 5
  fromEnum MetaVideoCodec = 6
  fromEnum MetaAudioCodec = 7
  fromEnum MetaSystemLayer = 8
  fromEnum MetaInputPlugin = 9
  fromEnum MetaDiscId = 10
  fromEnum MetaTrackNumber = 11
  fromEnum MetaComposer = 12
  fromEnum MetaPublisher = 13
  fromEnum MetaLicense = 15
  fromEnum MetaArranger = 16
  fromEnum MetaLyricist = 17
  fromEnum MetaConductor = 19
  fromEnum MetaPerformer = 20
  fromEnum MetaEnsemble = 21
  fromEnum MetaOpus = 22
  fromEnum MetaPart = 23
  fromEnum MetaPartNumber = 24
  fromEnum MetaLocation = 25

  toEnum 0 = MetaTitle
  toEnum 1 = MetaComment
  toEnum 2 = MetaArtist
  toEnum 3 = MetaGenre
  toEnum 4 = MetaAlbum
  toEnum 5 = MetaYear
  toEnum 6 = MetaVideoCodec
  toEnum 7 = MetaAudioCodec
  toEnum 8 = MetaSystemLayer
  toEnum 9 = MetaInputPlugin
  toEnum 10 = MetaDiscId
  toEnum 11 = MetaTrackNumber
  toEnum 12 = MetaComposer
  toEnum 13 = MetaPublisher
  toEnum 15 = MetaLicense
  toEnum 16 = MetaArranger
  toEnum 17 = MetaLyricist
  toEnum 19 = MetaConductor
  toEnum 20 = MetaPerformer
  toEnum 21 = MetaEnsemble
  toEnum 22 = MetaOpus
  toEnum 23 = MetaPart
  toEnum 24 = MetaPartNumber
  toEnum 25 = MetaLocation
  toEnum unmatched = error ("MetaType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 786 "./Xine/Foreign.chs" #-}

foreign import ccall safe "Xine/Foreign.chs.h xine_get_version_string"
  xine_get_version_string'_ :: (Ptr CChar)

foreign import ccall safe "Xine/Foreign.chs.h xine_get_version"
  xine_get_version'_ :: ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CInt) -> ())))

foreign import ccall safe "Xine/Foreign.chs.h xine_check_version"
  xine_check_version'_ :: (CInt -> (CInt -> (CInt -> CInt)))

foreign import ccall safe "Xine/Foreign.chs.h xine_new"
  xine_new'_ :: (IO (Ptr (Engine)))

foreign import ccall safe "Xine/Foreign.chs.h xine_init"
  xine_init'_ :: ((Ptr (Engine)) -> (IO ()))

foreign import ccall safe "Xine/Foreign.chs.h xine_open_audio_driver"
  xine_open_audio_driver'_ :: ((Ptr (Engine)) -> ((Ptr CChar) -> ((Ptr ()) -> (IO (Ptr (AudioPort))))))

foreign import ccall safe "Xine/Foreign.chs.h xine_open_video_driver"
  xine_open_video_driver'_ :: ((Ptr (Engine)) -> ((Ptr CChar) -> (CInt -> ((Ptr ()) -> (IO (Ptr (VideoPort)))))))

foreign import ccall safe "Xine/Foreign.chs.h xine_close_audio_driver"
  xine_close_audio_driver'_ :: ((Ptr (Engine)) -> ((Ptr (AudioPort)) -> (IO ())))

foreign import ccall safe "Xine/Foreign.chs.h xine_close_video_driver"
  xine_close_video_driver'_ :: ((Ptr (Engine)) -> ((Ptr (VideoPort)) -> (IO ())))

foreign import ccall safe "Xine/Foreign.chs.h xine_exit"
  xine_exit'_ :: ((Ptr (Engine)) -> (IO ()))

foreign import ccall safe "Xine/Foreign.chs.h xine_stream_new"
  xine_stream_new'_ :: ((Ptr (Engine)) -> ((Ptr (AudioPort)) -> ((Ptr (VideoPort)) -> (IO (Ptr (Stream))))))

foreign import ccall safe "Xine/Foreign.chs.h xine_stream_master_slave"
  xine_stream_master_slave'_ :: ((Ptr (Stream)) -> ((Ptr (Stream)) -> (CInt -> (IO CInt))))

foreign import ccall safe "Xine/Foreign.chs.h xine_open"
  xine_open'_ :: ((Ptr (Stream)) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall safe "Xine/Foreign.chs.h xine_play"
  xine_play'_ :: ((Ptr (Stream)) -> (CInt -> (CInt -> (IO CInt))))

foreign import ccall safe "Xine/Foreign.chs.h xine_trick_mode"
  xine_trick_mode'_ :: ((Ptr (Stream)) -> (CInt -> (CInt -> (IO CInt))))

foreign import ccall safe "Xine/Foreign.chs.h xine_stop"
  xine_stop'_ :: ((Ptr (Stream)) -> (IO ()))

foreign import ccall safe "Xine/Foreign.chs.h xine_close"
  xine_close'_ :: ((Ptr (Stream)) -> (IO ()))

foreign import ccall safe "Xine/Foreign.chs.h xine_eject"
  xine_eject'_ :: ((Ptr (Stream)) -> (IO CInt))

foreign import ccall safe "Xine/Foreign.chs.h xine_dispose"
  xine_dispose'_ :: ((Ptr (Stream)) -> (IO ()))

foreign import ccall safe "Xine/Foreign.chs.h xine_engine_set_param"
  xine_engine_set_param'_ :: ((Ptr (Engine)) -> (CInt -> (CInt -> (IO ()))))

foreign import ccall safe "Xine/Foreign.chs.h xine_engine_get_param"
  xine_engine_get_param'_ :: ((Ptr (Engine)) -> (CInt -> (IO CInt)))

foreign import ccall safe "Xine/Foreign.chs.h xine_set_param"
  xine_set_param'_ :: ((Ptr (Stream)) -> (CInt -> (CInt -> (IO ()))))

foreign import ccall safe "Xine/Foreign.chs.h xine_get_param"
  xine_get_param'_ :: ((Ptr (Stream)) -> (CInt -> (IO CInt)))

foreign import ccall safe "Xine/Foreign.chs.h xine_get_error"
  xine_get_error'_ :: ((Ptr (Stream)) -> (IO CInt))

foreign import ccall safe "Xine/Foreign.chs.h xine_get_status"
  xine_get_status'_ :: ((Ptr (Stream)) -> (IO CInt))

foreign import ccall safe "Xine/Foreign.chs.h xine_get_audio_lang"
  xine_get_audio_lang'_ :: ((Ptr (Stream)) -> (CInt -> ((Ptr CChar) -> (IO CInt))))

foreign import ccall safe "Xine/Foreign.chs.h xine_get_spu_lang"
  xine_get_spu_lang'_ :: ((Ptr (Stream)) -> (CInt -> ((Ptr CChar) -> (IO CInt))))

foreign import ccall safe "Xine/Foreign.chs.h xine_get_pos_length"
  xine_get_pos_length'_ :: ((Ptr (Stream)) -> ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO CInt)))))

foreign import ccall safe "Xine/Foreign.chs.h xine_get_stream_info"
  xine_get_stream_info'_ :: ((Ptr (Stream)) -> (CInt -> (IO CUInt)))

foreign import ccall safe "Xine/Foreign.chs.h xine_get_meta_info"
  xine_get_meta_info'_ :: ((Ptr (Stream)) -> (CInt -> (IO (Ptr CChar))))