GstPlayer.hs

{-  
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2014 Piotr Borek
 *
 *  Distributed under the terms of the GPL (GNU Public License)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program 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 General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

module Mp.Player.GstPlayer (
    GstPlayer(),
    initGstPlayer,
    gstPlayerMainLoopBlocking,
    gstPlayerQuit,
    gstPlayerPlay,
    gstPlayerPause,
    gstPlayerStop,
    gstPlayerResume,
    gstPlayerSetVolume,
    gstPlayerGetTimeInfo,
    gstPlayerTimeoutAdd,
    gstPlayerAddIdle,
    gstBusAddWatch,
    gstPlayerSeek
) where

import System.Exit
import Control.Monad
import Data.Maybe
import Data.String.Utils

import qualified Media.Streaming.GStreamer as Gst
import qualified Media.Streaming.GStreamer.Core.Types as Gst
import qualified System.Glib.MainLoop as G
import qualified System.Glib.Properties as G
import qualified System.Glib.Signals as G

data GstPlayer = GstPlayer {
    gstPlayerSource   :: Gst.Element,
    gstPlayerVolume   :: Gst.Element,
    gstPlayerPipeline :: Gst.Element,
    gstPlayerMainLoop :: G.MainLoop
}

makeElement :: String -> String -> IO Gst.Element
makeElement factoryName name = do
    element <- Gst.elementFactoryMake factoryName $ Just name
    case element of
        Just e  -> return e
        Nothing -> do
            putStrLn $ "Could not create GStreamer \"" ++ factoryName ++ "\"element."
            exitFailure

initGstPlayer :: IO GstPlayer
initGstPlayer = do
    Gst.init

    mainLoop <- G.mainLoopNew Nothing True

    source   <- makeElement "uridecodebin"  "File source"
    convert  <- makeElement "audioconvert"  "Audio converter"
    volume   <- makeElement "volume"        "Audio volume"
    sink     <- makeElement "autoaudiosink" "Auto audio sink"

    pipeline <- Gst.pipelineNew "pipeline"

    mapM_ (Gst.binAdd $ Gst.castToBin pipeline) [source, convert, volume, sink]
    _ <- Gst.elementLink convert volume
    _ <- Gst.elementLink volume sink

    _ <- G.on source Gst.elementPadAdded $ padAddedHandler convert

    return $ GstPlayer source volume pipeline mainLoop

padAddedHandler :: Gst.Element -> Gst.Pad -> IO ()
padAddedHandler convert pad = do
    maybeSinkPad <- Gst.elementGetStaticPad convert "sink"
    let sinkPad = fromJust maybeSinkPad
    sinkPadIsLinked <- Gst.padIsLinked sinkPad

    unless sinkPadIsLinked $ do
        padCaps <- Gst.padGetCaps pad
        let capsStruct = fromJust $ Gst.capsGetStructure padCaps 0
        let structName = Gst.structureName capsStruct
        when (startswith "audio/x-raw" structName) $ Gst.padLink pad sinkPad >> return ()

gstPlayerGetTimeInfo :: GstPlayer -> IO (Maybe (Integer, Integer))
gstPlayerGetTimeInfo player = do
    position <- Gst.elementQueryPosition (gstPlayerPipeline player) Gst.FormatTime
    duration <- Gst.elementQueryDuration (gstPlayerPipeline player) Gst.FormatTime
    if (and [isJust position, isJust duration])
        then do
            let (_, position') = fromJust position
            let (_, duration') = fromJust duration
            return $ Just (fromIntegral (position' `div` Gst.second) :: Integer, fromIntegral (duration' `div` Gst.second) :: Integer)
        else
            return Nothing

gstPlayerTimeoutAdd :: Int -> IO Bool -> IO ()
gstPlayerTimeoutAdd time action = flip G.timeoutAdd time action >> return ()

gstBusAddWatch ::  GstPlayer -> Gst.BusFunc -> IO ()
gstBusAddWatch player action = do
    bus <- Gst.pipelineGetBus (Gst.castToPipeline $ gstPlayerPipeline player)
    _ <- Gst.busAddWatch bus G.priorityDefault action
    return ()

gstPlayerMainLoopBlocking :: GstPlayer -> IO ()
gstPlayerMainLoopBlocking player = G.mainLoopRun $ gstPlayerMainLoop player

-- Functions below can be called from any thread
gstPlayerAddIdle :: IO Bool -> IO ()
gstPlayerAddIdle callback = G.idleAdd callback G.priorityDefaultIdle >> return ()

gstPlayerQuit :: GstPlayer -> IO ()
gstPlayerQuit player = gstPlayerAddIdle $ do
    G.mainLoopQuit $ gstPlayerMainLoop player
    return False

gstPlayerPlay :: GstPlayer -> FilePath -> IO ()
gstPlayerPlay player file = gstPlayerAddIdle $ do
    let pipeline = gstPlayerPipeline player
    let source   = gstPlayerSource player
    _ <- Gst.elementSetState pipeline Gst.StateNull
    G.objectSetPropertyString "uri" source $ "file://" ++ file
    G.objectSetPropertyInt "buffer-size" source (4 * 1024 * 1024)
    _ <- Gst.elementSetState pipeline Gst.StatePlaying
    return False

gstPlayerPause :: GstPlayer -> IO ()
gstPlayerPause player = gstPlayerAddIdle $ do
    _ <- Gst.elementSetState (gstPlayerPipeline player) Gst.StatePaused
    return False

gstPlayerStop :: GstPlayer -> IO ()
gstPlayerStop player = gstPlayerAddIdle $ do
    _ <- Gst.elementSetState (gstPlayerPipeline player) Gst.StateNull
    return False

gstPlayerResume :: GstPlayer -> IO ()
gstPlayerResume player = gstPlayerAddIdle $ do
    _ <- Gst.elementSetState (gstPlayerPipeline player) Gst.StatePlaying
    return False

gstPlayerSetVolume :: GstPlayer -> Double -> IO ()
gstPlayerSetVolume player vol = gstPlayerAddIdle $ do
    let volume   = gstPlayerVolume player
    G.objectSetPropertyDouble "volume" volume vol
    return False

gstPlayerSeek :: GstPlayer -> Integer -> IO ()
gstPlayerSeek player pos = gstPlayerAddIdle $ do
    _ <- Gst.elementSeekSimple (gstPlayerPipeline player) Gst.FormatTime [Gst.SeekFlagFlush] $ fromIntegral $ (fromIntegral pos) * Gst.second
    return False