HaskellからGStreamerを叩く 2

コマンドライン引数に渡したファイルを再生する。

-- play-audio.hs

module Main where

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

maybeFail :: String -> Maybe a -> IO a
maybeFail message = maybe (fail message) return

busCall loop bus message = do
    case (Gst.messageType message) of
        Gst.MessageEOS -> mainLoopQuit loop
        Gst.MessageError -> do
            err <- maybeFail "no error message" $ Gst.messageParseError message
            putStrLn $ show err
            mainLoopQuit loop
        _ -> return ()
    return True

main = do
    args <- getArgs
    Gst.init
    loop <- mainLoopNew Nothing False
    (pl, _) <- Gst.parseLaunchFromArgs ["filesrc", "location=" ++ (head args), "!", "decodebin", "!", "autoaudiosink"]
    -- Gst.parseLaunch は何故か Gst.Element を返すのでキャストが要る
    pipeline <- maybeFail "couldnot open pipeline" pl >>= return . Gst.castToPipeline
    bus <- Gst.pipelineGetBus pipeline
    Gst.busAddWatch bus priorityDefault (busCall loop)
    Gst.elementSetState pipeline Gst.StatePlaying
    mainLoopRun loop
    Gst.elementSetState pipeline Gst.StateNull
    return ()

プラグイン使うならparseLaunchFromArgsを使うと楽。使わないと、パッドを動的に接続しないといけない。なぜか出来なくて詰んだ。次のコードはコンパイル通るけど動かない。

-- 失敗版

module Main where

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

maybeFail :: String -> Maybe a -> IO a
maybeFail message = maybe (fail message) return

busCall loop bus message = do
    case (Gst.messageType message) of
        Gst.MessageEOS -> mainLoopQuit loop
        Gst.MessageError -> do
            err <- maybeFail "no error message" $ Gst.messageParseError message
            putStrLn $ show err
            mainLoopQuit loop
        _ -> return ()
    return True

main = do
    args <- getArgs
    Gst.init
    loop <- mainLoopNew Nothing False
    -- Gst.pipelineNew は何故か Gst.Element を返すのでキャストが要る
    pipeline <- Gst.pipelineNew "pipeline0" >>= return . Gst.castToPipeline
    [source, decoder, sink] <- sequence $ map (\e ->
            Gst.elementFactoryMake e Nothing
            >>= maybeFail ("cannot open " ++ e))
            ["filesrc", "decodebin", "autoaudiosink"]
    location <- quarkFromString "location"
    objectSetPropertyString "location" source $ head args
    bus <- Gst.pipelineGetBus pipeline
    Gst.busAddWatch bus priorityDefault (busCall loop)
    sequence_ $ map (Gst.binAdd pipeline) [source, decoder, sink]
    Gst.elementLink source decoder
    on decoder (Signal $ connectGeneric "pad-added") $ Gst.elementLink decoder sink
    Gst.elementSetState pipeline Gst.StatePlaying
    mainLoopRun loop
    Gst.elementSetState pipeline Gst.StateNull
    return ()