module Xine (
XineConf(..), VisualType(..), defaultConf,
XineHandle, open, openWith, close, isClosed,
MRL, StreamId,
openStream, closeStream, getCurrent,
SeekArg(..),
play, seek, stop, pause,
EngineStatus(..), MetaType(..),
getStatus, getMetadata
) where
import Xine.Foreign
import Control.Concurrent.MVar
import Control.Monad (unless, when)
import qualified Data.Map as M
import Data.Maybe (fromJust)
data XineConf = XineConf
{ audioDriver :: !(Maybe String)
, videoDriver :: !(Maybe String)
, visualType :: !VisualType
}
defaultConf :: XineConf
defaultConf = XineConf
{ audioDriver = Nothing
, videoDriver = Nothing
, visualType = None
}
data HandleState = Closed | Open deriving Eq
data XineHandle_ = XineHandle_
{ hEngine :: !Engine
, hAudioPort :: !AudioPort
, hVideoPort :: !VideoPort
, hStreams :: !Streams
, hCurrent :: !(Maybe StreamId)
, hState :: !HandleState
}
type StreamId = Int
data Streams = Streams
{ mapping :: !(M.Map StreamId Stream)
, lastKey :: !StreamId
}
emptyStreams :: Streams
emptyStreams = Streams M.empty 0
addStream :: Stream -> Streams -> Streams
addStream x s =
let nextId = succ (lastKey s)
in s { mapping = M.insert nextId x (mapping s)
, lastKey = nextId }
delStream :: StreamId -> Streams -> Streams
delStream sid s = s { mapping = M.delete sid (mapping s) }
lookupStream :: StreamId -> Streams -> Maybe Stream
lookupStream sid s = M.lookup sid (mapping s)
streams :: Streams -> [Stream]
streams = M.elems . mapping
newtype XineHandle = XineHandle (MVar XineHandle_)
isClosed :: XineHandle -> IO Bool
isClosed (XineHandle hv) = withMVar hv $ \h -> return (hState h == Closed)
modifyXineHandle :: XineHandle -> (XineHandle_ -> IO XineHandle_) -> IO ()
modifyXineHandle h@(XineHandle hv) f = do
closed <- isClosed h
when closed (fail "XineHandle is closed")
modifyMVar_ hv f
withXineHandle :: XineHandle -> (XineHandle_ -> IO a) -> IO a
withXineHandle h@(XineHandle hv) f = do
closed <- isClosed h
when closed (fail "XineHandle is closed")
withMVar hv $ f
withStream :: XineHandle -> StreamId -> (Stream -> IO a) -> IO a
withStream h sid f = withXineHandle h $ \hv -> do
case lookupStream sid (hStreams hv) of
Just s -> f s
Nothing -> fail $ "No such stream: " ++ show sid
open :: IO XineHandle
open = openWith defaultConf
openWith :: XineConf -> IO XineHandle
openWith conf = do
engine <- xine_new
xine_init engine
ap <- maybe (fail "Failed to open the audio driver") return =<<
xine_open_audio_driver engine (audioDriver conf)
vp <- maybe (fail "Failed to open the video driver") return =<<
xine_open_video_driver engine (videoDriver conf) (visualType conf)
h_ <- newMVar $ XineHandle_ engine ap vp emptyStreams Nothing Open
return $ XineHandle h_
close :: XineHandle -> IO ()
close h@(XineHandle hv) = do
withXineHandle h $ \h_ -> do
mapM_ xine_close (streams $ hStreams h_)
xine_close_audio_driver (hEngine h_) (hAudioPort h_)
xine_close_video_driver (hEngine h_) (hVideoPort h_)
xine_exit (hEngine h_)
modifyMVar_ hv $ \x -> return x { hState = Closed }
openStream :: XineHandle -> MRL -> IO StreamId
openStream h uri = do
modifyXineHandle h $ \h_ -> do
st <- maybe (fail "Failed to open a new stream") return =<<
xine_stream_new (hEngine h_) (hAudioPort h_) (hVideoPort h_)
ret <- xine_open st uri
unless (ret == 1) (fail "Failed to open MRL")
let sm = addStream st (hStreams h_)
return $ h_ { hStreams = sm
, hCurrent = Just (lastKey sm) }
fromJust `fmap` getCurrent h
closeStream :: XineHandle -> StreamId -> IO ()
closeStream h sid = modifyXineHandle h $ \h_ -> do
case lookupStream sid (hStreams h_) of
Just st -> do
xine_close st
return $ h_ { hStreams = delStream sid (hStreams h_) }
Nothing -> return h_
getCurrent :: XineHandle -> IO (Maybe StreamId)
getCurrent h = withXineHandle h $ \hv -> return (hCurrent hv)
play :: XineHandle -> StreamId -> IO ()
play h sid = withStream h sid $ \st -> do
ret <- xine_play st 0 0
unless (ret == 1) (fail "Failed to start playback")
data SeekArg
= SeekTime Int
| SeekPos Int
deriving (Eq, Show)
seek :: XineHandle -> StreamId -> SeekArg -> IO ()
seek h sid arg = withStream h sid $ \st -> do
ret <- xine_trick_mode st (trick arg) (val arg)
unless (ret == 1) (fail "Seek failed")
where
val (SeekTime x) = x
val (SeekPos x) = x
trick (SeekTime _) = TrickSeekToTime
trick (SeekPos _) = TrickSeekToPosition
stop :: XineHandle -> StreamId -> IO ()
stop h sid = withStream h sid $ \st -> xine_stop st
pause :: XineHandle -> StreamId -> IO ()
pause h sid = withStream h sid $ \st -> do
s <- xine_get_param st Speed
let speed | s == Pause = Normal
| otherwise = Pause
xine_set_param st Speed speed
getStatus :: XineHandle -> IO EngineStatus
getStatus h = withXineHandle h $ \h_ ->
case hCurrent h_ of
Just sid -> xine_get_status (fromJust $ lookupStream sid (hStreams h_))
Nothing -> return Idle
getMetadata :: XineHandle -> StreamId -> MetaType -> IO String
getMetadata h sid m = withStream h sid $ \st -> xine_get_meta_info st m