haskellgstreamer

How to get two videos playing in the same window using Gstreamer?


I am trying to get two videos playing in the same window using videomixer in Gstreamer. I read here https://gstreamer.freedesktop.org/documentation/videomixer/index.html?gi-language=c that it is deprecated in favor of the compositor element, but I cannot get my videos to play with compositor, only videomixer.

I have tried to follow How to program videomixer using Gstreamer C API , trying to create and then manually link the videomixer's request pads, just as the answer provides, like so

{-# LANGUAGE OverloadedLabels  #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where

-- This is a translation of the Hello World gstreamer example to haskell
-- Original C source:
-- https://gstreamer.freedesktop.org/documentation/application-development/basics/helloworld.html
-- Written by Jaro Reinders on 2017-01-09
--
-- All comments are copied from the source C code

import qualified GI.GLib as GLib
import qualified GI.Gst  as Gst

import Data.GI.Base.Properties (setObjectPropertyInt32, setObjectPropertyString, setObjectPropertyDouble)

import Control.Monad (void, when, forever)
import Control.Concurrent
import System.Environment
import System.IO (stderr)
import System.Exit (exitFailure)
import Data.Text (pack, unpack)
import qualified Data.Text.IO as T
import Data.Maybe (fromMaybe)

busCall :: GLib.MainLoop -> Gst.Bus -> Gst.Message -> IO Bool
busCall loop _bus message = do
  messageTypes <- Gst.getMessageType message

  when (Gst.MessageTypeEos `elem` messageTypes) $ do
    putStrLn "End of stream"
    GLib.mainLoopQuit loop
    
  when (Gst.MessageTypeNewClock `elem` messageTypes) $ do
    putStrLn "New Clock"
    --(gerror,_debug) <- Gst.messageParseError message
    --T.hPutStrLn stderr . ("Error: " <>) =<< Gst.gerrorMessage gerror
    --GLib.mainLoopQuit loop

  when (Gst.MessageTypeClockLost `elem` messageTypes) $ do
    putStrLn "Clock Lost"

  when (Gst.MessageTypeError `elem` messageTypes) $ do
    (gerror,_debug) <- Gst.messageParseError message
    T.hPutStrLn stderr . ("Error: " <>) =<< Gst.gerrorMessage gerror
    GLib.mainLoopQuit loop

  return True

onPadAdded :: Gst.Element -> Gst.Pad -> IO ()
onPadAdded queuer pad = do
  -- We can now link this pad with the vorbis-decoder sink pad
  putStrLn "Dynamic pad created, linking demuxer/decoder"
  Just sinkPad <- Gst.elementGetStaticPad queuer "sink"
  void $ Gst.padLink pad sinkPad

main :: IO ()
main = do
  progName <- getProgName
  args <- getArgs

  -- Initialization
  void $ Gst.init Nothing

  --pipeline <- Gst.parseLaunch "filesrc name=my_filesrc ! mad ! osssink"
  --print pipeline

  loop <- GLib.mainLoopNew Nothing False

  -- Check input arguments
  when (length args /= 1) $ do
    T.hPutStrLn stderr $ "Usage: " <> pack progName <> " <video filename>"
    --exitFailure
  --let filename = head args

  --let methodname = last args

  -- Create gstreamer elements
  pipeline <- Gst.pipelineNew (Just "video-player")

  let makeElement factoryname name =
        fromMaybe (error $ unpack $ "Could not create " <> name)
        <$> Gst.elementFactoryMake factoryname (Just name)

  --test    <- makeElement  "videotestsrc"  "testsrc"
  source  <- makeElement  "filesrc"       "filesrc"
  source2 <- makeElement  "filesrc"       "filesrc2"
  --demuxer <- makeElement  "qtdemux"       "qt-demuxer"
  decode  <- makeElement  "decodebin"     "decoder"
  queuer  <- makeElement  "queue"         "queuer"
  conv    <- makeElement  "videoconvert"  "converter"
  conv2   <- makeElement  "videoconvert"  "converter2"
  box     <- makeElement  "videobox"      "videoboxer"
  box2    <- makeElement  "videobox"      "videoboxer2"
  mixer   <- makeElement  "videomixer"    "mix"
  --alpha   <- makeElement  "alpha"         "transparency"
  sink    <- makeElement  "d3dvideosink"  "video-output"
  

  -- Set up the pipeline

  -- we set the input filename to the source element
  --setObjectPropertyString source2 "location" (Just $ pack filename)
  setObjectPropertyString source  "location" (Just "12_24.mov")
  setObjectPropertyString source2 "location" (Just "0_12.mov")
  setObjectPropertyDouble box     "border-alpha" 0.0
  setObjectPropertyInt32  box     "right" 0
  setObjectPropertyDouble box2    "border-alpha" 0.0
  setObjectPropertyInt32  box2    "left" 0
  --setObjectPropertyString source2 "location" (Just $ pack arg)
  --setObjectPropertyInt32 alpha "method" 2

  --caps <- Gst.capsNewAny
  
  -- we add a message handler
  bus <- Gst.pipelineGetBus pipeline
  busWatchId <- Gst.busAddWatch bus GLib.PRIORITY_DEFAULT (busCall loop)

  -- we add all elements into the pipeline
  -- file-source | decoder | converter | alsa-output
  mapM_ (Gst.binAdd pipeline) [source, decode, queuer, conv, box, mixer, conv2, sink, source2, decode, queuer, conv, box2]

  

  -- we link the elements together
  -- file-source -> ogg-demuxer ~> vorbis-decoder -> converter -> alsa-output
  void $ Gst.elementLink source decode

  void $ Gst.elementLink source2 decode
  
  mixerSinkPadTemplate <- Gst.elementGetPadTemplate mixer "sink_%u"
  
  mixerSinkPad <- Gst.elementRequestPad mixer mixerSinkPadTemplate (Just "sink_%u") Nothing

  sinkPad <- Gst.elementGetStaticPad conv2 "src"

  void $ Gst.elementLink sinkPad mixerSinkPad
  --void $ Gst.elementLink conv sink

  let elementLinkMany (a:b:cs) = (&&) <$> Gst.elementLink a b <*> elementLinkMany (b:cs)
      elementLinkMany _ = return True

  void $ elementLinkMany [queuer, conv, box, mixer, conv2, sink]

  void $ elementLinkMany [queuer, conv, box2, sink]

  --void $ Gst.elementLink conv sink

  void $ Gst.onElementPadAdded decode (onPadAdded queuer)

  -- Set the pipeline to "playing" state
  putStrLn $ "Now playing: " {-++ filename-}
  void $ Gst.elementSetState pipeline Gst.StatePlaying

  -- Iterate
  #run loop
  
  -- Out of the main loop, clean up nicely
  putStrLn "Returned, stopping playback"
  void $ Gst.elementSetState pipeline Gst.StateNull

  putStrLn "Deleting pipeline"

But I get the following error

stack build
gtk-intro-twelve> build (lib + exe)
Preprocessing library for gtk-intro-twelve-0.1.0.0..
Building library for gtk-intro-twelve-0.1.0.0..
Preprocessing executable 'gtk-intro-twelve-exe' for gtk-intro-twelve-0.1.0.0..
Building executable 'gtk-intro-twelve-exe' for gtk-intro-twelve-0.1.0.0..
[1 of 2] Compiling Main [Source file changed]

D:\stack-projects\gtk-intro-twelve\app\Main.hs:133:19: error: [GHC-05617]
    * Could not solve: `Data.GI.Base.Overloading.CheckForAncestorType
                          (Maybe Gst.PadTemplate)
                          Gst.PadTemplate
                          (Data.GI.Base.Overloading.ParentTypes (Maybe Gst.PadTemplate))'
        arising from a use of `Gst.elementRequestPad'
    * In a stmt of a 'do' block:
        mixerSinkPad <- Gst.elementRequestPad
                          mixer mixerSinkPadTemplate (Just "sink_%u") Nothing
      In the expression:
        do progName <- getProgName
           args <- getArgs
           void $ Gst.init Nothing
           loop <- GLib.mainLoopNew Nothing False
           ....
      In an equation for `main':
          main
            = do progName <- getProgName
                 args <- getArgs
                 void $ Gst.init Nothing
                 ....
    |
133 |   mixerSinkPad <- Gst.elementRequestPad mixer mixerSinkPadTemplate (Just "sink_%u") Nothing
    |                   ^^^^^^^^^^^^^^^^^^^^^

D:\stack-projects\gtk-intro-twelve\app\Main.hs:133:19: error: [GHC-39999]
    * No instance for `Gst.GObject (Maybe Gst.PadTemplate)'
        arising from a use of `Gst.elementRequestPad'
    * In a stmt of a 'do' block:
        mixerSinkPad <- Gst.elementRequestPad
                          mixer mixerSinkPadTemplate (Just "sink_%u") Nothing
      In the expression:
        do progName <- getProgName
           args <- getArgs
           void $ Gst.init Nothing
           loop <- GLib.mainLoopNew Nothing False
           ....
      In an equation for `main':
          main
            = do progName <- getProgName
                 args <- getArgs
                 void $ Gst.init Nothing
                 ....
    |
133 |   mixerSinkPad <- Gst.elementRequestPad mixer mixerSinkPadTemplate (Just "sink_%u") Nothing
    |                   ^^^^^^^^^^^^^^^^^^^^^

D:\stack-projects\gtk-intro-twelve\app\Main.hs:137:10: error: [GHC-05617]
    * Could not solve: `Data.GI.Base.Overloading.CheckForAncestorType
                          (Maybe Gst.Pad)
                          Gst.Element
                          (Data.GI.Base.Overloading.ParentTypes (Maybe Gst.Pad))'
        arising from a use of `Gst.elementLink'
    * In the second argument of `($)', namely
        `Gst.elementLink sinkPad mixerSinkPad'
      In a stmt of a 'do' block:
        void $ Gst.elementLink sinkPad mixerSinkPad
      In the expression:
        do progName <- getProgName
           args <- getArgs
           void $ Gst.init Nothing
           loop <- GLib.mainLoopNew Nothing False
           ....
    |
137 |   void $ Gst.elementLink sinkPad mixerSinkPad
    |          ^^^^^^^^^^^^^^^

D:\stack-projects\gtk-intro-twelve\app\Main.hs:137:10: error: [GHC-39999]
    * No instance for `Gst.GObject (Maybe Gst.Pad)'
        arising from a use of `Gst.elementLink'
    * In the second argument of `($)', namely
        `Gst.elementLink sinkPad mixerSinkPad'
      In a stmt of a 'do' block:
        void $ Gst.elementLink sinkPad mixerSinkPad
      In the expression:
        do progName <- getProgName
           args <- getArgs
           void $ Gst.init Nothing
           loop <- GLib.mainLoopNew Nothing False
           ....
    |
137 |   void $ Gst.elementLink sinkPad mixerSinkPad
    |          ^^^^^^^^^^^^^^^

It says No instance for Gst.GObject (Maybe Gst.PadTemplate)' so I'm supposing it did not create the template even tho with mixerSinkPadTemplate <- Gst.elementGetPadTemplate mixer "sink_%u" it should have. Why could this be? Maybe because it is deprecated in favour of compositor element?

Next I tried Ura's comment link Videomixer fails on sources rather than Videotestsrc describing a whole videomixer pipeline. I tried to reproduce it but to no avail.

{-# LANGUAGE OverloadedLabels  #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where

-- This is a translation of the Hello World gstreamer example to haskell
-- Original C source:
-- https://gstreamer.freedesktop.org/documentation/application-development/basics/helloworld.html
-- Written by Jaro Reinders on 2017-01-09
--
-- All comments are copied from the source C code

import qualified GI.GLib as GLib
import qualified GI.Gst  as Gst

import Data.GI.Base.Properties (setObjectPropertyInt32, setObjectPropertyString, setObjectPropertyDouble)

import Control.Monad (void, when, forever)
import Control.Concurrent
import System.Environment
import System.IO (stderr)
import System.Exit (exitFailure)
import Data.Text (pack, unpack)
import qualified Data.Text.IO as T
import Data.Maybe (fromMaybe)

busCall :: GLib.MainLoop -> Gst.Bus -> Gst.Message -> IO Bool
busCall loop _bus message = do
  messageTypes <- Gst.getMessageType message

  when (Gst.MessageTypeEos `elem` messageTypes) $ do
    putStrLn "End of stream"
    GLib.mainLoopQuit loop
    
  when (Gst.MessageTypeNewClock `elem` messageTypes) $ do
    putStrLn "New Clock"
    --(gerror,_debug) <- Gst.messageParseError message
    --T.hPutStrLn stderr . ("Error: " <>) =<< Gst.gerrorMessage gerror
    --GLib.mainLoopQuit loop

  when (Gst.MessageTypeClockLost `elem` messageTypes) $ do
    putStrLn "Clock Lost"

  when (Gst.MessageTypeError `elem` messageTypes) $ do
    (gerror,_debug) <- Gst.messageParseError message
    T.hPutStrLn stderr . ("Error: " <>) =<< Gst.gerrorMessage gerror
    GLib.mainLoopQuit loop

  return True

onPadAdded :: Gst.Element -> Gst.Pad -> IO ()
onPadAdded conv pad = do
  -- We can now link this pad with the vorbis-decoder sink pad
  putStrLn "Dynamic pad created, linking demuxer/decoder"
  Just sinkPad <- Gst.elementGetStaticPad conv "sink"
  void $ Gst.padLink pad sinkPad

main :: IO ()
main = do
  progName <- getProgName
  args <- getArgs

  -- Initialization
  void $ Gst.init Nothing

  --pipeline <- Gst.parseLaunch "filesrc name=my_filesrc ! mad ! osssink"
  --print pipeline

  loop <- GLib.mainLoopNew Nothing False

  -- Check input arguments
  when (length args /= 1) $ do
    T.hPutStrLn stderr $ "Usage: " <> pack progName <> " <video filename>"
    --exitFailure
  --let filename = head args

  --let methodname = last args

  -- Create gstreamer elements
  pipeline <- Gst.pipelineNew (Just "video-player")

  let makeElement factoryname name =
        fromMaybe (error $ unpack $ "Could not create " <> name)
        <$> Gst.elementFactoryMake factoryname (Just name)

  --test    <- makeElement  "videotestsrc"  "testsrc"
  source  <- makeElement  "filesrc"       "filesrc"
  source2 <- makeElement  "filesrc"       "filesrc2"
  --demuxer <- makeElement  "qtdemux"       "qt-demuxer"
  decode  <- makeElement  "decodebin"     "decoder"
  --queuer  <- makeElement  "queue"         "queuer"
  conv    <- makeElement  "videoconvert"  "converter"
  --conv2   <- makeElement  "videoconvert"  "converter2"
  box     <- makeElement  "videobox"      "videoboxer"
  box2    <- makeElement  "videobox"      "videoboxer2"
  mixer   <- makeElement  "videomixer"    "mix"
  --alpha   <- makeElement  "alpha"         "transparency"
  sink    <- makeElement  "d3dvideosink"  "video-output"
  

  -- Set up the pipeline

  -- we set the input filename to the source element
  --setObjectPropertyString source2 "location" (Just $ pack filename)
  setObjectPropertyString source  "location" (Just "12_24.mov")
  setObjectPropertyString source2 "location" (Just "0_12.mov")
  setObjectPropertyDouble box     "border-alpha" 0.0
  setObjectPropertyInt32  box     "right" 0
  setObjectPropertyDouble box2    "border-alpha" 0.0
  setObjectPropertyInt32  box2    "left" 0
  --setObjectPropertyString source2 "location" (Just $ pack arg)
  --setObjectPropertyInt32 alpha "method" 2

  --caps <- Gst.capsNewAny
  
  -- we add a message handler
  bus <- Gst.pipelineGetBus pipeline
  busWatchId <- Gst.busAddWatch bus GLib.PRIORITY_DEFAULT (busCall loop)

  -- we add all elements into the pipeline
  -- file-source | decoder | converter | alsa-output
  mapM_ (Gst.binAdd pipeline) [source, decode, conv, box, mixer, conv, source2, decode, conv, box2, sink]

  

  -- we link the elements together
  -- file-source -> ogg-demuxer ~> vorbis-decoder -> converter -> alsa-output
  void $ Gst.elementLink source decode
  void $ Gst.elementLink decode conv
  void $ Gst.elementLink conv box
  void $ Gst.elementLink box mixer

  void $ Gst.elementLink source2 decode
  void $ Gst.elementLink decode conv
  void $ Gst.elementLink conv box2
  void $ Gst.elementLink box2 mixer

  void $ Gst.elementLink mixer sink

  --void $ Gst.elementLink source2 decode
  
  {-mixerSinkPadTemplate <- Gst.elementGetPadTemplate mixer "sink_%u"
  
  mixerSinkPad <- Gst.elementRequestPad mixer mixerSinkPadTemplate (Just "sink_%u") Nothing

  sinkPad <- Gst.elementGetStaticPad conv2 "src"

  void $ Gst.elementLink sinkPad mixerSinkPad-}
  --void $ Gst.elementLink conv sink

  {-let elementLinkMany (a:b:cs) = (&&) <$> Gst.elementLink a b <*> elementLinkMany (b:cs)
      elementLinkMany _ = return True

  void $ elementLinkMany [source, decode, queuer, conv, box, mixer, conv2, sink]

  void $ elementLinkMany [source2, decode, queuer, conv2, box2, mixer, conv2, sink]-}

  --void $ Gst.elementLink conv sink

  --void $ Gst.onElementPadAdded decode (onPadAdded queuer)

  -- Set the pipeline to "playing" state
  putStrLn $ "Now playing: " {-++ filename-}
  void $ Gst.elementSetState pipeline Gst.StatePlaying

  -- Iterate
  #run loop
  
  -- Out of the main loop, clean up nicely
  putStrLn "Returned, stopping playback"
  void $ Gst.elementSetState pipeline Gst.StateNull

  putStrLn "Deleting pipeline"

But I get the error

stack exec gtk-intro-twelve-exe
Usage: gtk-intro-twelve-exe.EXE <video filename>
Error: Internal data stream error.
Now playing: 
Returned, stopping playback
Deleting pipeline

Internal data stream error, hmm... I'm not sure what that could be as running gst-launch-1.0 filesrc location=12_24.mov ! decodebin ! videoconvert ! videobox border-alpha=0 right=0 ! videomixer name=mix ! d3dvideosink filesrc location=0_12.mov ! decodebin ! videoconvert ! videobox border-alpha=0 left=0 ! mix. from powershell works just fine. My pipeline is a bit different from Sarpkaya's so maybe that has something to do with it? Or maybe it's because it's a very old post, from 2011, and some things might have changed throughout the years? Quite possible. Still I would really appreciate some feedback from you guys. I might look into some more recent posts as well. Thank you in advance :)


Solution

  • You need to pattern match on the result of elementGetPadTemplate and say what to do when it fails.

    maybeMixerSinkPadTemplate <- Gst.elementGetPadTemplate mixer "sink_%u"
    mixerSinkPadTemplate <- case maybeMixerSinkPadTemplate of
        Nothing -> fail "this kills the program" -- or whatever other recovery action you want
        Just v -> v
    -- then do something that uses mixerSinkPadTemplate