Create a GTK video player using Haskell

When we last settled on Movie Monad , we created a desktop video player using all web technologies (HTML, CSS, JavaScript and Electron). The trick was that all the source code for the project was written in Haskell.

One of the limitations of our web approach was that the size of the video file could not be too large, otherwise the application would fall. To avoid this, we implemented a file size check and warned the user that the limit was exceeded.

We could continue to develop our approach with the web by setting the backend to stream the video file to the HTML5 server, by running the server and the Electron application in parallel. Instead, we abandon web technologies and turn to GTK +, Gstreamer and the X11 window management system.

If you use another window management system, for example, Wayland, Quartz or WinAPI, then this approach can be adapted to work with your GDK backend. Adaptation is to embed a GStreamer playbin video output into a Movie Monad window.

GDK is an important aspect of GTK + portability. Since Glib already provides low-level cross-platform functionality, in order to make GTK + work on other platforms you only need to port the GDK to the basic graphical level of the operating system. That is, it is GDK ports on the Windows API and Quartz that allow GTK + applications to run on Windows and macOS ( source ).

Who is this article for?

For Haskell programmers who want to implement a GTK + user interface.
For programmers interested in functional programming.
For the creators of the GUI.
For those who are looking for alternatives to GitHub Electron.
For fans of video players.

What we look at

Stack.
Bindings haskell-gi
Directory of various data and files with them.
Glade.
GTK +.
GStreamer.
How to create a movie monad.

Project Setup

First we need to set up a machine for developing Haskell programs, as well as set up files and dependencies for the project directory.

Haskell Platform

If your machine is not yet ready to develop Haskell programs, you can get everything you need by downloading and installing the Haskell platform .

Stack

If you do not already have a Stack , then be sure to install it before you start developing. But if you have already used the Haskell platform, then you already have the Stack.

ExifTool

Before playing the video in Movie Monad, we need to collect some information about the file selected by the user. To do this, use ExifTool . If you are working on Linux, then there is a great chance that you already have this tool ( which exiftool ). ExifTool is available for Windows, Mac and Linux.

Project files

There are three ways to get project files.

 wget https://github.com/lettier/movie-monad/archive/master.zip unzip master.zip mv movie-monad-master movie-monad cd movie-monad/

You can download the ZIP archive and extract them.

 git clone git@github.com:lettier/movie-monad.git cd movie-monad/

You can make a Git-clone using SSH.

 git clone https://github.com/lettier/movie-monad.git cd movie-monad/

You can clone git over https.

haskell-gi

haskell-gi is able to generate Haskell bindings to libraries using middleware self-diagnostics (introspection middleware) GObject . At the time of this writing, all the necessary bindings are available on Hackage .

Dependencies

Now install the dependencies of the project.

 cd movie-monad/ stack install --dependencies-only

Code

Now we set up the introduction of Movie Monad. You can delete the source files and recreate them, or follow the instructions.

Paths_movie_monad.hs

Paths_movie_monad.hs used to search for the Glade XML GUI file during runtime. Since we are developing, we will use a dummy module ( movie-monad/src/dev/Paths_movie_monad.hs ) to search for the file movie-monad/src/data/gui.glade . After the project is built / installed, the real Paths_movie_monad module will be generated automatically. It will provide us with the getDataFileName function. It assigns to its output a prefix in the form of an absolute path where data-dir (movie-monad/src/) data-files copied or installed.

 {-# LANGUAGE OverloadedStrings #-} module Paths_movie_monad where dataDir :: String dataDir = "./src/" getDataFileName :: FilePath -> IO FilePath getDataFileName a = do putStrLn "You are using a fake Paths_movie_monad." return (dataDir ++ "/" ++ a)

Dummy module Paths_movie_monad .

 {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-missing-import-lists #-} {-# OPTIONS_GHC -fno-warn-implicit-prelude #-} module Paths_movie_monad ( version, getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getDataFileName, getSysconfDir ) where import qualified Control.Exception as Exception import Data.Version (Version(..)) import System.Environment (getEnv) import Prelude #if defined(VERSION_base) #if MIN_VERSION_base(4,0,0) catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a #else catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a #endif #else catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a #endif catchIO = Exception.catch version :: Version version = Version [0,0,0,0] [] bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath bindir = "/home/<snip>/.stack-work/install/x86_64-linux-nopie/lts-9.1/8.0.2/bin" libdir = "/home/<snip>/.stack-work/install/x86_64-linux-nopie/lts-9.1/8.0.2/lib/x86_64-linux-ghc-8.0.2/movie-monad-0.0.0.0" dynlibdir = "/home/<snip>/.stack-work/install/x86_64-linux-nopie/lts-9.1/8.0.2/lib/x86_64-linux-ghc-8.0.2" datadir = "/home/<snip>/.stack-work/install/x86_64-linux-nopie/lts-9.1/8.0.2/share/x86_64-linux-ghc-8.0.2/movie-monad-0.0.0.0" libexecdir = "/home/<snip>/.stack-work/install/x86_64-linux-nopie/lts-9.1/8.0.2/libexec" sysconfdir = "/home/<snip>/.stack-work/install/x86_64-linux-nopie/lts-9.1/8.0.2/etc" getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath getBinDir = catchIO (getEnv "movie_monad_bindir") (\_ -> return bindir) getLibDir = catchIO (getEnv "movie_monad_libdir") (\_ -> return libdir) getDynLibDir = catchIO (getEnv "movie_monad_dynlibdir") (\_ -> return dynlibdir) getDataDir = catchIO (getEnv "movie_monad_datadir") (\_ -> return datadir) getLibexecDir = catchIO (getEnv "movie_monad_libexecdir") (\_ -> return libexecdir) getSysconfDir = catchIO (getEnv "movie_monad_sysconfdir") (\_ -> return sysconfdir) getDataFileName :: FilePath -> IO FilePath getDataFileName name = do dir <- getDataDir return (dir ++ "/" ++ name)

Automatically generated module Paths_movie_monad .

Main.hs

Main.hs is the entry point for Movie Monad. In this file, we set up our window with different widgets, connect GStreamer, and when the user logs off, we demolish the window.

Pragmas

We need to tell the compiler (GHC) that we need overloaded string and lexically scoped type variables.

OverloadedStrings allows us to use string literals ( "Literal" ) where String/[Char] or Text are required. ScopedTypeVariables allows us to use the type signature in the parameter parameter of the lambda function, which is passed to the interception when calling ExifTool.

 {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}

Imports

 module Main where import Prelude import Foreign.C.Types import System.Process import System.Exit import Control.Monad import Control.Exception import Text.Read import Data.IORef import Data.Maybe import Data.Int import Data.Text import Data.GI.Base import Data.GI.Base.Signals import Data.GI.Base.Properties import GI.GLib import GI.GObject import qualified GI.Gtk import GI.Gst import GI.GstVideo import GI.Gdk import GI.GdkX11 import Paths_movie_monad

Since we are working with C bindings, we will need to work with types that already exist in this language. A considerable part of the imports are the bindings generated by haskell-gi.

IsVideoOverlay

GStreamer video gi-gstvideo ( gi-gstvideo ) contain a class of type (interface) IsVideoOverlay . GStreamer bindings ( gi-gst ) contain an element type. To use the playbin element with the playbin function, we need to declare a GI.Gst.Element - an instance of type (type instance) IsVideoOverlay . And on the C side, playbin implements the VideoOverlay interface.

 newtype GstElement = GstElement GI.Gst.Element instance GI.GstVideo.IsVideoOverlay GstElement

Notice that we wrap a GI.Gst.Element into a new type (newtype) to avoid the appearance of a lost (orphaned) instance, since we are declaring an instance outside the haskell-gi bindings.

main

Main is our biggest feature. In it, we initialize all GUI widgets and define callback procedures based on certain events.

 main :: IO () main = do

GI initialization

  _ <- GI.Gst.init Nothing _ <- GI.Gtk.init Nothing

Here we initialized GStreamer and GTK +.

Build GUI widgets

  gladeFile <- getDataFileName "data/gui.glade" builder <- GI.Gtk.builderNewFromFile (pack gladeFile) window <- builderGetObject GI.Gtk.Window builder "window" fileChooserButton <- builderGetObject GI.Gtk.FileChooserButton builder "file-chooser-button" drawingArea <- builderGetObject GI.Gtk.Widget builder "drawing-area" seekScale <- builderGetObject GI.Gtk.Scale builder "seek-scale" onOffSwitch <- builderGetObject GI.Gtk.Switch builder "on-off-switch" volumeButton <- builderGetObject GI.Gtk.VolumeButton builder "volume-button" desiredVideoWidthComboBox <- builderGetObject GI.Gtk.ComboBoxText builder "desired-video-width-combo-box" fullscreenButton <- builderGetObject GI.Gtk.Button builder "fullscreen-button" errorMessageDialog <- builderGetObject GI.Gtk.MessageDialog builder "error-message-dialog" aboutButton <- builderGetObject GI.Gtk.Button builder "about-button" aboutDialog <- builderGetObject GI.Gtk.AboutDialog builder "about-dialog"

As already mentioned, we get the absolute path to the XML data/gui.glade , which describes all our GUI widgets. Next we create a constructor from this file and get our widgets. If we didn’t use Glade, we’d have to create them manually, which is quite tedious.

Playbin

  playbin <- fromJust <$> GI.Gst.elementFactoryMake "playbin" (Just "MultimediaPlayer")

Here we create a playbin GStreamer pipeline. It is designed to address a variety of needs and saves us time creating our own pipeline. Let's call this element MultimediaPlayer .

Embed GStreamer output

In order for GTK + and GStreamer to work together, we need to tell GStreamer exactly where to output the video. If this is not done, then GStreamer will create its own window, since we use playbin .

  _ <- GI.Gtk.onWidgetRealize drawingArea $ onDrawingAreaRealize drawingArea playbin fullscreenButton -- ... onDrawingAreaRealize :: GI.Gtk.Widget -> GI.Gst.Element -> GI.Gtk.Button -> GI.Gtk.WidgetRealizeCallback onDrawingAreaRealize drawingArea playbin fullscreenButton = do gdkWindow <- fromJust <$> GI.Gtk.widgetGetWindow drawingArea x11Window <- GI.Gtk.unsafeCastTo GI.GdkX11.X11Window gdkWindow xid <- GI.GdkX11.x11WindowGetXid x11Window let xid' = fromIntegral xid :: CUIntPtr GI.GstVideo.videoOverlaySetWindowHandle (GstElement playbin) xid' GI.Gtk.widgetHide fullscreenButton

Here you see the callback setup as soon as the drawingArea widget is drawingArea . It is in this widget that GStreamer should show videos. We get the parent GDK window for the render area widget. Then we get the window handler, or XID of the X11 system of our GTK + window. The CUIntPtr string converts the ID from CULong to CUIntPtr required for videoOverlaySetWindowHandle . When we get the correct type, we notify GStreamer that with the help of the xid' handler it can draw the output of the playbin in our window.

Because of the bug in Glade, we programmatically hide the full-screen widget, because if you uncheck the visible box in Glade, the widget will not be hidden anyway.

Please note that you need to adapt Movie Monad to work with the window system, if you are using not some other X system.

File selection

  _ <- GI.Gtk.onFileChooserButtonFileSet fileChooserButton $ onFileChooserButtonFileSet playbin fileChooserButton volumeButton isWindowFullScreenRef desiredVideoWidthComboBox onOffSwitch fullscreenButton drawingArea window errorMessageDialog -- ... onFileChooserButtonFileSet :: GI.Gst.Element -> GI.Gtk.FileChooserButton -> GI.Gtk.VolumeButton -> IORef Bool -> GI.Gtk.ComboBoxText -> GI.Gtk.Switch -> GI.Gtk.Button -> GI.Gtk.Widget -> GI.Gtk.Window -> GI.Gtk.MessageDialog -> GI.Gtk.FileChooserButtonFileSetCallback onFileChooserButtonFileSet playbin fileChooserButton volumeButton isWindowFullScreenRef desiredVideoWidthComboBox onOffSwitch fullscreenButton drawingArea window errorMessageDialog = do _ <- GI.Gst.elementSetState playbin GI.Gst.StateNull filename <- fromJust <$> GI.Gtk.fileChooserGetFilename fileChooserButton setPlaybinUriAndVolume playbin filename volumeButton isWindowFullScreen <- readIORef isWindowFullScreenRef desiredVideoWidth <- getDesiredVideoWidth desiredVideoWidthComboBox maybeWindowSize <- getWindowSize desiredVideoWidth filename case maybeWindowSize of Nothing -> do _ <- GI.Gst.elementSetState playbin GI.Gst.StatePaused GI.Gtk.windowUnfullscreen window GI.Gtk.switchSetActive onOffSwitch False GI.Gtk.widgetHide fullscreenButton GI.Gtk.widgetShow desiredVideoWidthComboBox resetWindowSize desiredVideoWidth fileChooserButton drawingArea window _ <- GI.Gtk.onDialogResponse errorMessageDialog (\ _ -> GI.Gtk.widgetHide errorMessageDialog) void $ GI.Gtk.dialogRun errorMessageDialog Just (width, height) -> do _ <- GI.Gst.elementSetState playbin GI.Gst.StatePlaying GI.Gtk.switchSetActive onOffSwitch True GI.Gtk.widgetShow fullscreenButton unless isWindowFullScreen $ setWindowSize width height fileChooserButton drawingArea window

To start a video playback session, the user must be able to select a video file. After the file is selected, you need to perform a series of mandatory actions so that everything works well.

We get the file name from the file selection widget.
We playbin which file it should play.
Make the volume level in the widget the same as in playbin .
Based on the desired image width and video size, we determine the appropriate width and height of the window.
If the window sizes are successfully received:
- Start playing the file.
- We transfer the pause / play button to the “on” state.
- Show fullscreen widget.
- If the video is not in full screen mode:
- Change the window size to match the relative video size.
If unable to get window dimensions:
- Put the playbin on pause.
- Turn the switch to the "off" position.
- If it is possible, we deduce a window from the full-screen mode.
- Reset the window size.
- Display a small dialog error message.

Pause and play

  _ <- GI.Gtk.onSwitchStateSet onOffSwitch (onSwitchStateSet playbin) -- ... onSwitchStateSet :: GI.Gst.Element -> Bool -> IO Bool onSwitchStateSet playbin switchOn = do if switchOn then void $ GI.Gst.elementSetState playbin GI.Gst.StatePlaying else void $ GI.Gst.elementSetState playbin GI.Gst.StatePaused return switchOn

It's simple. If the switch is in the “on” position, then we set the playbin element to the playbin element. Otherwise, we give it a pause state.

Volume setting

  _ <- GI.Gtk.onScaleButtonValueChanged volumeButton (onScaleButtonValueChanged playbin) -- ... onScaleButtonValueChanged :: GI.Gst.Element -> Double -> IO () onScaleButtonValueChanged playbin volume = void $ Data.GI.Base.Properties.setObjectPropertyDouble playbin "volume" volume

When the volume in the widget changes, we pass its value to GStreamer so that it can adjust the volume to play.

Moving around the video

  seekScaleHandlerId <- GI.Gtk.onRangeValueChanged seekScale (onRangeValueChanged playbin seekScale) -- ... onRangeValueChanged :: GI.Gst.Element -> GI.Gtk.Scale -> IO () onRangeValueChanged playbin seekScale = do (couldQueryDuration, duration) <- GI.Gst.elementQueryDuration playbin GI.Gst.FormatTime when couldQueryDuration $ do percentage' <- GI.Gtk.rangeGetValue seekScale let percentage = percentage' / 100.0 let position = fromIntegral (round ((fromIntegral duration :: Double) * percentage) :: Int) :: Int64 void $ GI.Gst.elementSeekSimple playbin GI.Gst.FormatTime [ GI.Gst.SeekFlagsFlush ] position

In Movie Monad, there is a playback scale in which you can move the slider forward / backward, thereby navigating through video frames.

The scale from 0 to 100% represents the total duration of the video file. If you move the slider, for example, to 50, then we move to the timestamp, which is in the middle between the beginning and the end. It would be possible to adjust the scale from zero to the duration of the video, but the described method is more versatile.

Please note that for this callback we use a signal ID ( seekScaleHandlerId ), since we will need it later.

Update Playback Scale

  _ <- GI.GLib.timeoutAddSeconds GI.GLib.PRIORITY_DEFAULT 1 (updateSeekScale playbin seekScale seekScaleHandlerId) -- ... updateSeekScale :: GI.Gst.Element -> GI.Gtk.Scale -> Data.GI.Base.Signals.SignalHandlerId -> IO Bool updateSeekScale playbin seekScale seekScaleHandlerId = do (couldQueryDuration, duration) <- GI.Gst.elementQueryDuration playbin GI.Gst.FormatTime (couldQueryPosition, position) <- GI.Gst.elementQueryPosition playbin GI.Gst.FormatTime let percentage = if couldQueryDuration && couldQueryPosition && duration > 0 then 100.0 * (fromIntegral position / fromIntegral duration :: Double) else 0.0 GI.GObject.signalHandlerBlock seekScale seekScaleHandlerId GI.Gtk.rangeSetValue seekScale percentage GI.GObject.signalHandlerUnblock seekScale seekScaleHandlerId return True

To synchronize the scale and the video playback process itself, you need to transfer messages between GTK + and GStreamer. Every second we will request the current playback position and update the scale in accordance with it. So we show the user how much of the file is already shown, and the slider will always correspond to the real position of the playback.

In order not to initiate a previously configured callback, we disable the onRangeValueChanged signal onRangeValueChanged when updating the playback scale. The onRangeValueChanged onRangeValueChanged should only be executed if the user changes the position of the slider.

Video resizing

  _ <- GI.Gtk.onComboBoxChanged desiredVideoWidthComboBox $ onComboBoxChanged fileChooserButton desiredVideoWidthComboBox drawingArea window -- ... onComboBoxChanged :: GI.Gtk.FileChooserButton -> GI.Gtk.ComboBoxText -> GI.Gtk.Widget -> GI.Gtk.Window -> IO () onComboBoxChanged fileChooserButton desiredVideoWidthComboBox drawingArea window = do filename' <- GI.Gtk.fileChooserGetFilename fileChooserButton let filename = fromMaybe "" filename' desiredVideoWidth <- getDesiredVideoWidth desiredVideoWidthComboBox maybeWindowSize <- getWindowSize desiredVideoWidth filename case maybeWindowSize of Nothing -> resetWindowSize desiredVideoWidth fileChooserButton drawingArea window Just (width, height) -> setWindowSize width height fileChooserButton drawingArea window

This widget allows the user to select the desired video width. The height will be selected automatically based on the aspect ratio of the video file.

Full screen mode

  _ <- GI.Gtk.onWidgetButtonReleaseEvent fullscreenButton (onFullscreenButtonRelease isWindowFullScreenRef desiredVideoWidthComboBox fileChooserButton window) -- ... onFullscreenButtonRelease :: IORef Bool -> GI.Gtk.ComboBoxText -> GI.Gtk.FileChooserButton -> GI.Gtk.Window -> GI.Gdk.EventButton -> IO Bool onFullscreenButtonRelease isWindowFullScreenRef desiredVideoWidthComboBox fileChooserButton window _ = do isWindowFullScreen <- readIORef isWindowFullScreenRef if isWindowFullScreen then do GI.Gtk.widgetShow desiredVideoWidthComboBox GI.Gtk.widgetShow fileChooserButton void $ GI.Gtk.windowUnfullscreen window else do GI.Gtk.widgetHide desiredVideoWidthComboBox GI.Gtk.widgetHide fileChooserButton void $ GI.Gtk.windowFullscreen window return True

When the user releases the widget's button in full-screen mode, we switch the state of the full-screen mode of the window, hide the file selection panel and the video width selection widget. When you exit the full-screen mode, we restore the panel and widget.

Please note that we don’t show a fullscreen widget if we don’t have a video.

  _ <- GI.Gtk.onWidgetWindowStateEvent window (onWidgetWindowStateEvent isWindowFullScreenRef) -- ... onWidgetWindowStateEvent :: IORef Bool -> GI.Gdk.EventWindowState -> IO Bool onWidgetWindowStateEvent isWindowFullScreenRef eventWindowState = do windowStates <- GI.Gdk.getEventWindowStateNewWindowState eventWindowState let isWindowFullScreen = Prelude.foldl (\ acc x -> acc || GI.Gdk.WindowStateFullscreen == x) False windowStates writeIORef isWindowFullScreenRef isWindowFullScreen return True

To control the full-screen state of the window, we need to set up a callback so that it starts up every time the window state changes. Different callbacks depend on the full screen state information. As an aid, we use IORef , from which each function will read and to which it will write a callback. This IORef is a modifiable (and common) link. Ideally, we need to request a window exactly when it is in full-screen mode, but there is no API for it. Therefore, we will use a variable link.

Due to the use of a single writer and heap of signal callbacks in the main execution thread, we avoid possible traps of the general changeable state. If we were concerned about thread safety, we could use MVar , TVar or atomicModifyIORef .

About the program

  _ <- GI.Gtk.onWidgetButtonReleaseEvent aboutButton (onAboutButtonRelease aboutDialog) -- ... onAboutButtonRelease :: GI.Gtk.AboutDialog -> GI.Gdk.EventButton -> IO Bool onAboutButtonRelease aboutDialog _ = do _ <- GI.Gtk.onDialogResponse aboutDialog (\ _ -> GI.Gtk.widgetHide aboutDialog) _ <- GI.Gtk.dialogRun aboutDialog return True

The last widget in question is the About dialog box. Here we associate the dialog box with the “About” button displayed in the main window.

Closing the window

  _ <- GI.Gtk.onWidgetDestroy window (onWindowDestroy playbin) -- ... onWindowDestroy :: GI.Gst.Element -> IO () onWindowDestroy playbin = do _ <- GI.Gst.elementSetState playbin GI.Gst.StateNull _ <- GI.Gst.objectUnref playbin GI.Gtk.mainQuit

When the user closes the window, we destroy the playbin pipeline and exit the main GTK loop.

Launch

  GI.Gtk.widgetShowAll window GI.Gtk.main

Finally, we show or draw the main window and start the main GTK + loop. It is blocked until the mainQuit .

Complete Main.hs file

Below is the file movie-monad/src/Main.hs Different helper functions related to main are not shown.

 {- Movie Monad (C) 2017 David lettier lettier.com -} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where import Prelude import Foreign.C.Types import System.Process import System.Exit import Control.Monad import Control.Exception import Text.Read import Data.IORef import Data.Maybe import Data.Int import Data.Text import Data.GI.Base import Data.GI.Base.Signals import Data.GI.Base.Properties import GI.GLib import GI.GObject import qualified GI.Gtk import GI.Gst import GI.GstVideo import GI.Gdk import GI.GdkX11 import Paths_movie_monad -- Declare Element a type instance of IsVideoOverlay via a newtype wrapper -- Our GStreamer element is playbin -- Playbin implements the GStreamer VideoOverlay interface newtype GstElement = GstElement GI.Gst.Element instance GI.GstVideo.IsVideoOverlay GstElement main :: IO () main = do _ <- GI.Gst.init Nothing _ <- GI.Gtk.init Nothing gladeFile <- getDataFileName "data/gui.glade" builder <- GI.Gtk.builderNewFromFile (pack gladeFile) window <- builderGetObject GI.Gtk.Window builder "window" fileChooserButton <- builderGetObject GI.Gtk.FileChooserButton builder "file-chooser-button" drawingArea <- builderGetObject GI.Gtk.Widget builder "drawing-area" seekScale <- builderGetObject GI.Gtk.Scale builder "seek-scale" onOffSwitch <- builderGetObject GI.Gtk.Switch builder "on-off-switch" volumeButton <- builderGetObject GI.Gtk.VolumeButton builder "volume-button" desiredVideoWidthComboBox <- builderGetObject GI.Gtk.ComboBoxText builder "desired-video-width-combo-box" fullscreenButton <- builderGetObject GI.Gtk.Button builder "fullscreen-button" errorMessageDialog <- builderGetObject GI.Gtk.MessageDialog builder "error-message-dialog" aboutButton <- builderGetObject GI.Gtk.Button builder "about-button" aboutDialog <- builderGetObject GI.Gtk.AboutDialog builder "about-dialog" playbin <- fromJust <$> GI.Gst.elementFactoryMake "playbin" (Just "MultimediaPlayer") isWindowFullScreenRef <- newIORef False _ <- GI.Gtk.onWidgetRealize drawingArea $ onDrawingAreaRealize drawingArea playbin fullscreenButton _ <- GI.Gtk.onFileChooserButtonFileSet fileChooserButton $ onFileChooserButtonFileSet playbin fileChooserButton volumeButton isWindowFullScreenRef desiredVideoWidthComboBox onOffSwitch fullscreenButton drawingArea window errorMessageDialog _ <- GI.Gtk.onSwitchStateSet onOffSwitch (onSwitchStateSet playbin) _ <- GI.Gtk.onScaleButtonValueChanged volumeButton (onScaleButtonValueChanged playbin) seekScaleHandlerId <- GI.Gtk.onRangeValueChanged seekScale (onRangeValueChanged playbin seekScale) _ <- GI.GLib.timeoutAddSeconds GI.GLib.PRIORITY_DEFAULT 1 (updateSeekScale playbin seekScale seekScaleHandlerId) _ <- GI.Gtk.onComboBoxChanged desiredVideoWidthComboBox $ onComboBoxChanged fileChooserButton desiredVideoWidthComboBox drawingArea window _ <- GI.Gtk.onWidgetButtonReleaseEvent fullscreenButton (onFullscreenButtonRelease isWindowFullScreenRef desiredVideoWidthComboBox fileChooserButton window) _ <- GI.Gtk.onWidgetWindowStateEvent window (onWidgetWindowStateEvent isWindowFullScreenRef) _ <- GI.Gtk.onWidgetButtonReleaseEvent aboutButton (onAboutButtonRelease aboutDialog) _ <- GI.Gtk.onWidgetDestroy window (onWindowDestroy playbin) GI.Gtk.widgetShowAll window GI.Gtk.main builderGetObject :: (GI.GObject.GObject b, GI.Gtk.IsBuilder a) => (Data.GI.Base.ManagedPtr b -> b) -> a -> Prelude.String -> IO b builderGetObject objectTypeClass builder objectId = fromJust <$> GI.Gtk.builderGetObject builder (pack objectId) >>= GI.Gtk.unsafeCastTo objectTypeClass onDrawingAreaRealize :: GI.Gtk.Widget -> GI.Gst.Element -> GI.Gtk.Button -> GI.Gtk.WidgetRealizeCallback onDrawingAreaRealize drawingArea playbin fullscreenButton = do gdkWindow <- fromJust <$> GI.Gtk.widgetGetWindow drawingArea x11Window <- GI.Gtk.unsafeCastTo GI.GdkX11.X11Window gdkWindow xid <- GI.GdkX11.x11WindowGetXid x11Window let xid' = fromIntegral xid :: CUIntPtr GI.GstVideo.videoOverlaySetWindowHandle (GstElement playbin) xid' GI.Gtk.widgetHide fullscreenButton onFileChooserButtonFileSet :: GI.Gst.Element -> GI.Gtk.FileChooserButton -> GI.Gtk.VolumeButton -> IORef Bool -> GI.Gtk.ComboBoxText -> GI.Gtk.Switch -> GI.Gtk.Button -> GI.Gtk.Widget -> GI.Gtk.Window -> GI.Gtk.MessageDialog -> GI.Gtk.FileChooserButtonFileSetCallback onFileChooserButtonFileSet playbin fileChooserButton volumeButton isWindowFullScreenRef desiredVideoWidthComboBox onOffSwitch fullscreenButton drawingArea window errorMessageDialog = do _ <- GI.Gst.elementSetState playbin GI.Gst.StateNull filename <- fromJust <$> GI.Gtk.fileChooserGetFilename fileChooserButton setPlaybinUriAndVolume playbin filename volumeButton isWindowFullScreen <- readIORef isWindowFullScreenRef desiredVideoWidth <- getDesiredVideoWidth desiredVideoWidthComboBox maybeWindowSize <- getWindowSize desiredVideoWidth filename case maybeWindowSize of Nothing -> do _ <- GI.Gst.elementSetState playbin GI.Gst.StatePaused GI.Gtk.windowUnfullscreen window GI.Gtk.switchSetActive onOffSwitch False GI.Gtk.widgetHide fullscreenButton GI.Gtk.widgetShow desiredVideoWidthComboBox resetWindowSize desiredVideoWidth fileChooserButton drawingArea window _ <- GI.Gtk.onDialogResponse errorMessageDialog (\ _ -> GI.Gtk.widgetHide errorMessageDialog) void $ GI.Gtk.dialogRun errorMessageDialog Just (width, height) -> do _ <- GI.Gst.elementSetState playbin GI.Gst.StatePlaying GI.Gtk.switchSetActive onOffSwitch True GI.Gtk.widgetShow fullscreenButton unless isWindowFullScreen $ setWindowSize width height fileChooserButton drawingArea window onSwitchStateSet :: GI.Gst.Element -> Bool -> IO Bool onSwitchStateSet playbin switchOn = do if switchOn then void $ GI.Gst.elementSetState playbin GI.Gst.StatePlaying else void $ GI.Gst.elementSetState playbin GI.Gst.StatePaused return switchOn onScaleButtonValueChanged :: GI.Gst.Element -> Double -> IO () onScaleButtonValueChanged playbin volume = void $ Data.GI.Base.Properties.setObjectPropertyDouble playbin "volume" volume onRangeValueChanged :: GI.Gst.Element -> GI.Gtk.Scale -> IO () onRangeValueChanged playbin seekScale = do (couldQueryDuration, duration) <- GI.Gst.elementQueryDuration playbin GI.Gst.FormatTime when couldQueryDuration $ do percentage' <- GI.Gtk.rangeGetValue seekScale let percentage = percentage' / 100.0 let position = fromIntegral (round ((fromIntegral duration :: Double) * percentage) :: Int) :: Int64 void $ GI.Gst.elementSeekSimple playbin GI.Gst.FormatTime [ GI.Gst.SeekFlagsFlush ] position updateSeekScale :: GI.Gst.Element -> GI.Gtk.Scale -> Data.GI.Base.Signals.SignalHandlerId -> IO Bool updateSeekScale playbin seekScale seekScaleHandlerId = do (couldQueryDuration, duration) <- GI.Gst.elementQueryDuration playbin GI.Gst.FormatTime (couldQueryPosition, position) <- GI.Gst.elementQueryPosition playbin GI.Gst.FormatTime let percentage = if couldQueryDuration && couldQueryPosition && duration > 0 then 100.0 * (fromIntegral position / fromIntegral duration :: Double) else 0.0 GI.GObject.signalHandlerBlock seekScale seekScaleHandlerId GI.Gtk.rangeSetValue seekScale percentage GI.GObject.signalHandlerUnblock seekScale seekScaleHandlerId return True onComboBoxChanged :: GI.Gtk.FileChooserButton -> GI.Gtk.ComboBoxText -> GI.Gtk.Widget -> GI.Gtk.Window -> IO () onComboBoxChanged fileChooserButton desiredVideoWidthComboBox drawingArea window = do filename' <- GI.Gtk.fileChooserGetFilename fileChooserButton let filename = fromMaybe "" filename' desiredVideoWidth <- getDesiredVideoWidth desiredVideoWidthComboBox maybeWindowSize <- getWindowSize desiredVideoWidth filename case maybeWindowSize of Nothing -> resetWindowSize desiredVideoWidth fileChooserButton drawingArea window Just (width, height) -> setWindowSize width height fileChooserButton drawingArea window onFullscreenButtonRelease :: IORef Bool -> GI.Gtk.ComboBoxText -> GI.Gtk.FileChooserButton -> GI.Gtk.Window -> GI.Gdk.EventButton -> IO Bool onFullscreenButtonRelease isWindowFullScreenRef desiredVideoWidthComboBox fileChooserButton window _ = do isWindowFullScreen <- readIORef isWindowFullScreenRef if isWindowFullScreen then do GI.Gtk.widgetShow desiredVideoWidthComboBox GI.Gtk.widgetShow fileChooserButton void $ GI.Gtk.windowUnfullscreen window else do GI.Gtk.widgetHide desiredVideoWidthComboBox GI.Gtk.widgetHide fileChooserButton void $ GI.Gtk.windowFullscreen window return True onWidgetWindowStateEvent :: IORef Bool -> GI.Gdk.EventWindowState -> IO Bool onWidgetWindowStateEvent isWindowFullScreenRef eventWindowState = do windowStates <- GI.Gdk.getEventWindowStateNewWindowState eventWindowState let isWindowFullScreen = Prelude.foldl (\ acc x -> acc || GI.Gdk.WindowStateFullscreen == x) False windowStates writeIORef isWindowFullScreenRef isWindowFullScreen return True onAboutButtonRelease :: GI.Gtk.AboutDialog -> GI.Gdk.EventButton -> IO Bool onAboutButtonRelease aboutDialog _ = do _ <- GI.Gtk.onDialogResponse aboutDialog (\ _ -> GI.Gtk.widgetHide aboutDialog) _ <- GI.Gtk.dialogRun aboutDialog return True onWindowDestroy :: GI.Gst.Element -> IO () onWindowDestroy playbin = do _ <- GI.Gst.elementSetState playbin GI.Gst.StateNull _ <- GI.Gst.objectUnref playbin GI.Gtk.mainQuit setPlaybinUriAndVolume :: GI.Gst.Element -> Prelude.String -> GI.Gtk.VolumeButton -> IO () setPlaybinUriAndVolume playbin filename volumeButton = do let uri = "file://" ++ filename volume <- GI.Gtk.scaleButtonGetValue volumeButton Data.GI.Base.Properties.setObjectPropertyDouble playbin "volume" volume Data.GI.Base.Properties.setObjectPropertyString playbin "uri" (Just $ pack uri) getVideoInfo :: Prelude.String -> Prelude.String -> IO (Maybe Prelude.String) getVideoInfo flag filename = do (code, out, _) <- catch ( readProcessWithExitCode "exiftool" [flag, "-s", "-S", filename] "" ) (\ (_ :: Control.Exception.IOException) -> return (ExitFailure 1, "", "")) if code == System.Exit.ExitSuccess then return (Just out) else return Nothing isVideo :: Prelude.String -> IO Bool isVideo filename = do maybeOut <- getVideoInfo "-MIMEType" filename case maybeOut of Nothing -> return False Just out -> return ("video" `isInfixOf` pack out) getWindowSize :: Int -> Prelude.String -> IO (Maybe (Int32, Int32)) getWindowSize desiredVideoWidth filename = isVideo filename >>= getWidthHeightString >>= splitWidthHeightString >>= widthHeightToDouble >>= ratio >>= windowSize where getWidthHeightString :: Bool -> IO (Maybe Prelude.String) getWidthHeightString False = return Nothing getWidthHeightString True = getVideoInfo "-ImageSize" filename splitWidthHeightString :: Maybe Prelude.String -> IO (Maybe [Text]) splitWidthHeightString Nothing = return Nothing splitWidthHeightString (Just string) = return (Just (Data.Text.splitOn "x" (pack string))) widthHeightToDouble :: Maybe [Text] -> IO (Maybe Double, Maybe Double) widthHeightToDouble (Just (x:y:_)) = return (readMaybe (unpack x) :: Maybe Double, readMaybe (unpack y) :: Maybe Double) widthHeightToDouble _ = return (Nothing, Nothing) ratio :: (Maybe Double, Maybe Double) -> IO (Maybe Double) ratio (Just width, Just height) = if width <= 0.0 then return Nothing else return (Just (height / width)) ratio _ = return Nothing windowSize :: Maybe Double -> IO (Maybe (Int32, Int32)) windowSize Nothing = return Nothing windowSize (Just ratio') = return (Just (fromIntegral desiredVideoWidth :: Int32, round ((fromIntegral desiredVideoWidth :: Double) * ratio') :: Int32)) getDesiredVideoWidth :: GI.Gtk.ComboBoxText -> IO Int getDesiredVideoWidth = fmap (\ x -> read (Data.Text.unpack x) :: Int) . GI.Gtk.comboBoxTextGetActiveText setWindowSize :: Int32 -> Int32 -> GI.Gtk.FileChooserButton -> GI.Gtk.Widget -> GI.Gtk.Window -> IO () setWindowSize width height fileChooserButton drawingArea window = do GI.Gtk.setWidgetWidthRequest fileChooserButton width GI.Gtk.setWidgetWidthRequest drawingArea width GI.Gtk.setWidgetHeightRequest drawingArea height GI.Gtk.setWidgetWidthRequest window width GI.Gtk.setWidgetHeightRequest window height GI.Gtk.windowResize window width (if height <= 0 then 1 else height) resetWindowSize :: (Integral a) => a -> GI.Gtk.FileChooserButton -> GI.Gtk.Widget -> GI.Gtk.Window -> IO () resetWindowSize width' fileChooserButton drawingArea window = do let width = fromIntegral width' :: Int32 GI.Gtk.widgetQueueDraw drawingArea setWindowSize width 0 fileChooserButton drawingArea window

Movie Monad

, Movie Monad .

 cd movie-monad/ stack clean stack install stack exec -- movie-monad # Or just `movie-monad` if `stack path | grep local-bin-path` is in your `echo $PATH`

, Movie Monad .

Conclusion

Movie Monad , GTK+ GStreamer. , Electron-. Movie Monad .

GTK+ . , GTK+ ~50 , Electron — ~300 (500%- ).

, GTK+ . , Electron - . haskell-gi .

, GTK+ Haskell, Gifcurry . .

Source: https://habr.com/ru/post/338176/

All Articles