module Manatee.Extension.Mplayer.Daemon where
import Control.Applicative hiding (empty)
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import DBus.Client hiding (Signal)
import Data.Maybe (isNothing)
import Manatee.Extension.Mplayer.DBus
import Manatee.Toolkit.General.Basic
import Manatee.Toolkit.General.DBus
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.STM
import System.IO
import System.Posix.Types (ProcessID)
import System.Process
import Data.ByteString.UTF8
type MplayerHandle = (Handle, Handle, Handle, ProcessHandle)
data MplayerStatus =
MplayerStatus {mplayerHandle :: TVar (Maybe MplayerHandle)
,mplayerPlayStatus :: TVar PlayStatus
,mplayerStopByCommand :: MVar String
,mplayerProcessId :: TVar (Maybe ProcessID)
,mplayerClient :: Client
,mplayerSentinelThreadId :: TVar (Maybe ThreadId)
}
data PlayStatus = PlayStatus
| PauseStatus
| StopStatus
deriving (Show, Eq, Ord)
mplayerInitStatus :: IO MplayerStatus
mplayerInitStatus =
MplayerStatus <$> newTVarIO Nothing
<*> newTVarIO PauseStatus
<*> newEmptyMVar
<*> newTVarIO Nothing
<*> mkSessionClient
<*> newTVarIO Nothing
mplayerPlay :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()
mplayerPlay status@(MplayerStatus {mplayerHandle = handle
,mplayerPlayStatus = playStatus
,mplayerStopByCommand = byCommand
,mplayerProcessId = processId})
(PlayArgs filepath pid) = do
mplayerStopInternal status
newHandle@(inp, oup, err, ph) <- runInteractiveCommand $ "mplayer -slave \"" ++ toString filepath ++ "\""
hSetBuffering inp NoBuffering
hSetBuffering oup NoBuffering
hSetBuffering err NoBuffering
writeTVarIO handle (Just newHandle)
writeTVarIO playStatus PlayStatus
writeTVarIO processId (Just pid)
tryTakeMVar byCommand
forkIO $ mplayerSentinelProcess status ph
return ()
mplayerSentinelProcess :: MplayerStatus -> ProcessHandle -> IO ()
mplayerSentinelProcess MplayerStatus {mplayerStopByCommand = byCommand
,mplayerProcessId = processId
,mplayerClient = client
,mplayerSentinelThreadId = threadId}
processHandle = do
myThreadId >>= \ tId -> writeTVarIO threadId (Just tId)
_ <- waitForProcess processHandle
mvar <- tryTakeMVar byCommand
when (isNothing mvar) $
readTVarIO processId >?>= \pid ->
readTVarIO threadId >?>= \tId -> do
currentThreadId <- myThreadId
when (currentThreadId == tId) $
mkMplayerClientSignal client pid PlayFinished PlayFinishedArgs
mplayerPause :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()
mplayerPause status@(MplayerStatus {mplayerPlayStatus = playStatus})
PauseArgs = do
mplayerSendCommand status "pause" False
modifyTVarIO playStatus
(\ stat -> case stat of
PlayStatus -> PauseStatus
_ -> PlayStatus)
mplayerStop :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()
mplayerStop status@(MplayerStatus {mplayerHandle = handle
,mplayerPlayStatus = playStatus}) StopArgs = do
mplayerStopInternal status
writeTVarIO handle Nothing
writeTVarIO playStatus StopStatus
mplayerStopInternal :: MplayerStatus -> IO ()
mplayerStopInternal MplayerStatus {mplayerHandle = handle
,mplayerStopByCommand = byCommand
,mplayerSentinelThreadId = threadId} =
readTVarIO handle >?>= \ (inp, _, _, _) -> do
tryTakeMVar byCommand >> putMVar byCommand "Stop by command : mplayerStop"
writeTVarIO threadId Nothing
whenM (mplayerProcessIsActivated handle) $ hPutStrLn inp "quit"
mplayerForward :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()
mplayerForward status (ForwardArgs step) =
mplayerSendCommand status ("seek " ++ show step) True
mplayerBackward :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()
mplayerBackward status (BackwardArgs step) =
mplayerSendCommand status ("seek -" ++ show step) True
mplayerVolumeInc :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()
mplayerVolumeInc status (VolumeIncArgs step) =
mplayerSendCommand status ("volume " ++ show step) True
mplayerVolumeDec :: MplayerStatus -> MplayerDaemonSignalArgs -> IO ()
mplayerVolumeDec status (VolumeDecArgs step) =
mplayerSendCommand status ("volume -" ++ show step) True
mplayerProcessIsActivated :: TVar (Maybe MplayerHandle) -> IO Bool
mplayerProcessIsActivated handle = do
h <- readTVarIO handle
case h of
Just (_, _, _, ph) -> liftM isNothing $ getProcessExitCode ph
Nothing -> return False
mplayerSendCommand :: MplayerStatus -> String -> Bool -> IO ()
mplayerSendCommand MplayerStatus {mplayerHandle = handle
,mplayerPlayStatus = playStatus}
command
needPlaying = do
stat <- readTVarIO playStatus
when (not needPlaying || stat == PlayStatus) $
readTVarIO handle >?>= \ (inp, _, _, _) ->
whenM (mplayerProcessIsActivated handle) $
hPutStrLn inp command