, ,

Let’s fabricate a GTK Video Participant with Haskell by David Lettier

news image

Overview

When we final left off with Film Monad, we had constructed a desktop video participant the usage of all net-basically basically basically based technologies (HTML, CSS, JavaScript, and Electron). The twist modified into once that each of the source code for the accomplishing modified into once written in Haskell.

Likely the most boundaries of our net-basically basically basically based plot modified into once that the video file dimension could presumably per chance well also most fantastic be so sizable. If the file dimension modified into once too sizable, it will fracture the applying. To steer clear of this, we place in a file dimension test and told the particular person if the video file modified into once too sizable.

We could presumably per chance well also continue with the get hang of-basically basically basically based plot and setup a support-cease server to spin the video file to the HTML5 participant and sprint the server and the Electron application aspect-by-aspect. As a alternative we can slump with a non-net-basically basically basically based plot the usage of GTK+, GStreamer, and the X11 windowing draw. Trace that when you exercise but one more windowing draw, resembling Wayland, Quartz, or WinAPI, this plot could presumably per chance well be adapted to work with your explicit GDK support-cease. The adaptation piece being the embedding of the GStreamer playbin video output into the Film Monad window.

GDK is a considerable piece of GTK+’s portability. Since low-stage antagonistic-platform efficiency is already supplied by GLib, all that is considerable to manufacture GTK+ sprint on different platforms is to port GDK to the underlying working draw’s graphics layer. Therefore, the GDK ports to the Windows API and Quartz are what makes GTK+ capabilities sprint on Windows and macOS, respectively.

Who this is for

  • Haskell programmers searching to manufacture a GTK+ particular person interface (UI)
  • Programmers thinking about life like programming
  • GUI builders
  • Those attempting to search out a replace for GitHub’s Electron
  • Video participant aficionados

What we can quilt

  • Stack
  • The haskell-gi bindings
  • Cabal files itemizing and files files
  • Glade
  • GTK+
  • GStreamer
  • Easy solutions to manufacture Film Monad

Project setup

Sooner than we can open up, we can need our machine setup to assemble Haskell capabilities and our accomplishing itemizing setup with its files and dependencies.

Haskell Platform

In case your machine in no longer already setup to assemble Haskell capabilities, you’ll discover a plot to manufacture all that we can need by downloading and putting in the Haskell Platform.

Stack

Must you are setup to assemble with Haskell but elevate out no longer possess Stack, make wonderful that to win Stack place in sooner than you open up. Trace that when you ragged the Haskell Platform, you ought to already possess Stack.

ExifTool

Sooner than we can play a video in Film Monad, we can opt to amass some particulars referring to the file the particular person selected. We could presumably per chance well be the usage of ExifTool to amass these particulars. Must you’re the usage of some Linux distribution, there is a legit chance that you simply already possess it (which exiftool). ExifTool is on hand for Windows, Mac, and Linux.

Project files

There are 3 systems you’ll discover a plot to manufacture the accomplishing files.

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

It’s seemingly you’ll presumably per chance well also win the ZIP and extract it.

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

It’s seemingly you’ll presumably per chance well also Git clone it with SSH.

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

It’s seemingly you’ll presumably per chance well also Git clone it with HTTPS.

haskell-gi

haskell-gi is able to generating Haskell bindings for libraries that exercise the GObject introspection middleware. On the time of this writing, sure bindings we can need are no longer on hand on Hackage. Thus we can exercise haskell-gi to generate these bindings for us. For now, enable us to install haskell-gi.

cd movie-monad/
stack setup
stack install haskell-gi

xlib

We can need a binding to the xlib library.

cd movie-monad/
haskell-gi -o lib/gi-xlib/xlib.overrides -O lib/gi-xlib xlib

GdkX11-3.zero

We can need a binding to the GdkX11 library.

cd movie-monad/
haskell-gi -o lib/gi-gdkx11/GdkX11.overrides -O lib/gi-gdkx11 GdkX11-3.zero

Dependencies

Stir forward now and install the accomplishing dependencies.

cd movie-monad/
stack install --dependencies-most fantastic

The code

We’re now setup to enforce Film Monad. It’s seemingly you’ll presumably per chance well also either delete the source files and recreate them or staunch discover along.

Paths_movie_monad.hs

Paths_movie_monad.hs is ragged to search out our Glade XML GUI file at runtime. While we’re creating, we exercise a dummy module (movie-monad/src/dev/Paths_movie_monad.hs) to search out the movie-monad/src/files/gui.glade file. After we fabricate/install the accomplishing, the correct Paths_movie_monad module is auto generated. This auto generated module presents us with the getDataFileName feature. getDataFileName prefixes its enter with the absolute route to the place the files-dir (movie-monad/src/) files-files were copied or place in to.

{-# LANGUAGE OverloadedStrings #-}

module Paths_movie_monad the place

dataDir :: String
dataDir = "./src/"

getDataFileName :: FilePath -> IO FilePath
getDataFileName a = elevate out
  putStrLn "It's seemingly you'll presumably per chance well also very effectively be the usage of a flawed Paths_movie_monad."
  return (dataDir ++ "/" ++ a)

The dummy Paths_movie_monad module.

{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-lacking-import-lists #-}
{-# OPTIONS_GHC -fno-warn-implicit-prelude #-}
module Paths_movie_monad (
    version,
    getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,
    getDataFileName, getSysconfDir
  ) the place

import certified Preserve a watch on.Exception as Exception
import Records.Version (Version(..))
import Machine.Atmosphere (getEnv)
import Prelude

#if outlined(VERSION_base)

#if MIN_VERSION_base(Four,zero,zero)
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.take

version :: Version
version = Version [zero,zero,zero,zero] []
bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath

bindir     = "/home//.stack-work/install/x86_64-linux-nopie/lts-9.1/eight.zero.2/bin"
libdir     = "/home//.stack-work/install/x86_64-linux-nopie/lts-9.1/eight.zero.2/lib/x86_64-linux-ghc-eight.zero.2/movie-monad-zero.zero.zero.zero"
dynlibdir  = "/home//.stack-work/install/x86_64-linux-nopie/lts-9.1/eight.zero.2/lib/x86_64-linux-ghc-eight.zero.2"
datadir    = "/home//.stack-work/install/x86_64-linux-nopie/lts-9.1/eight.zero.2/share/x86_64-linux-ghc-eight.zero.2/movie-monad-zero.zero.zero.zero"
libexecdir = "/home//.stack-work/install/x86_64-linux-nopie/lts-9.1/eight.zero.2/libexec"
sysconfdir = "/home//.stack-work/install/x86_64-linux-nopie/lts-9.1/eight.zero.2/and so forth"

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 title = elevate out
  dir <- getDataDir
  return (dir ++ "/" ++ title)

The auto generated Paths_movie_monad module.

Predominant.hs

Predominant.hs is the entry level for Film Monad. In this file we setup our window with its diversified widgets, we wire up GStreamer, and we teardown our window once the particular person exits.

Pragmas

We’d like to dispute the compiler (GHC) that we need overloaded strings and lexically scoped style variables. OverloadedStrings lets in us to exercise string literals ("Literal") in areas that demand String/[Char] or Text. ScopedTypeVariables lets in us to exercise a form signature in the parameter sample of the lambda feature passed to take when calling ExifTool.

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

Imports

module Predominant the place

import Prelude
import International.C.Kinds
import Machine.Project
import Machine.Exit
import Preserve a watch on.Monad
import Preserve a watch on.Exception
import Records.Perchance
import Records.Int
import Records.Text
import Records.String.Utils
import Records.GI.Hideous
import Records.GI.Hideous.Properties
import GI.GLib
import GI.GObject
import certified GI.Gtk
import GI.Gst
import GI.GstVideo
import GI.GdkX11
import Paths_movie_monad

Since we’re dealing with C bindings, we can opt to work with kinds that exist in the C language. A sizable portion of the imports are the bindings generated by haskell-gi.

IsVideoOverlay

The GStreamer video bindings (gi-gstvideo) possess an IsVideoOverlay style class (interface). The GStreamer bindings (gi-gst) possess a share style. In dispute to exercise playbin (a share) with the feature GI.GstVideo.videoOverlaySetWindowHandle, we must expose GI.Gst.Element a form occasion of IsVideoOverlay. On the C aspect, playbin implements the VideoOverlay interface.

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

Trace that we wrap GI.Gst.Element in a newtype to steer clear of an orphaned occasion since we’re declaring the occasion out of doors of the haskell-gi bindings.

most considerable

most considerable is our largest feature the place we initialize all the GUI widgets and clarify callback procedures in accordance with sure events.

GI initialization

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

Here we initialize GStreamer and GTK+.

Constructing our GUI widgets

  gladeFile <- getDataFileName "files/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-place"
  seekScale <- builderGetObject GI.Gtk.Scale builder "look-scale"
  onOffSwitch <- builderGetObject GI.Gtk.Switch builder "on-off-swap"
  volumeButton <- builderGetObject GI.Gtk.VolumeButton builder "volume-button"
  desiredVideoWidthComboBox <- builderGetObject GI.Gtk.ComboBoxText builder "desired-video-width-combo-field"
  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 described earlier, we fabricate the absolute route to the files/gui.glade file which is a XML file describing all of our GUI widgets. Subsequent we fabricate a builder from the file and assemble each of our GUI widgets. If we didn’t exercise Glade, we would possess needed to manufacture all of these widgets manually which can change into rather verbose and unhurried.

Playbin

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

Here we fabricate a GStreamer pipeline called playbin. This pipeline is setup to take care of a big diversity of wants and saves us the time of having to manufacture our appreciate pipeline. We give this ingredient the title MultimediaPlayer.

Embedding the GStreamer output

Two assemble GTK+ and GStreamer, we need a mode to dispute GStreamer the place to render the video to. If we provide out no longer dispute GStreamer the place to render to, this can fabricate its appreciate window since we’re the usage of playbin.

  _ <- GI.Gtk.onWidgetRealize drawingArea $ elevate out
    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'

Here you understand the callback setup for when our drawingArea widget is ready. The drawingArea is the place we need GStreamer to render to. We fabricate the guardian GDK window for the drawing place widget. Subsequent we win the window take care of or XID of the X11 window powering our GTK+ window. The CUIntPtr line is changing the ID from CULong to CUIntPtr which videoOverlaySetWindowHandle expects. Once now we possess the coolest style, we dispute GStreamer that it can presumably per chance well render the output of playbin to our window with the take care of xid'.

Trace that here is the place you can adapt Film Monad to work with your windowing draw when you raze up the usage of something different than the X windowing draw.

Deciding on the file

  _ <- GI.Gtk.onFileChooserButtonFileSet fileChooserButton $ elevate out
    _ <- GI.Gst.elementSetState playbin GI.Gst.StateNull

    filename <- fromJust <$> GI.Gtk.fileChooserGetFilename fileChooserButton
    let uri = "file://" ++ filename

    volume <- GI.Gtk.scaleButtonGetValue volumeButton
    Records.GI.Hideous.Properties.setObjectPropertyDouble playbin "volume" volume
    Records.GI.Hideous.Properties.setObjectPropertyString playbin "uri" (Correct $ pack uri)

    desiredVideoWidth <- getDesiredVideoWidth desiredVideoWidthComboBox
    (success, width, high) <- getWindowSize desiredVideoWidth filename

    if success
      then elevate out
        _ <- GI.Gst.elementSetState playbin GI.Gst.StatePlaying
        GI.Gtk.switchSetActive onOffSwitch Factual
        setWindowSize width high fileChooserButton drawingArea window
      else elevate out
        _ <- GI.Gst.elementSetState playbin GI.Gst.StatePaused
        GI.Gtk.switchSetActive onOffSwitch Unsuitable
        resetWindowSize desiredVideoWidth fileChooserButton drawingArea window
        _ <- GI.Gtk.onDialogResponse errorMessageDialog ( _ -> GI.Gtk.widgetHide errorMessageDialog)
        void $ GI.Gtk.dialogRun errorMessageDialog

To kick off a video playing session, the particular person ought to discover a plot to get a video file. After they invent out get a file, we must originate some severe steps to make wonderful that all the pieces goes smoothly.

  • Secure the file title from the file chooser widget
  • Expose playbin what file it must play
  • Situation the playbin volume to the amount widget stage
  • Resolve the appropriate window width and high in accordance with the specified video width option and the video dimension
  • If getting the window dimension modified into once a success
    • Commence playing the video
    • Situation the toggle play/cease button to the on express
    • Resize the window to suit the relative dimension of the video
  • Else if getting the window dimension modified into once a failure
    • Expose playbin to cease
    • Situation the toggle swap to the off plan
    • Reset the window dimension
    • Display a exiguous dialog field informing the particular person of an error occurring

Play and cease

  _ <- GI.Gtk.onSwitchStateSet onOffSwitch $  switchOn -> elevate out
    if switchOn
      then void $ GI.Gst.elementSetState playbin GI.Gst.StatePlaying
      else void $ GI.Gst.elementSetState playbin GI.Gst.StatePaused
    return switchOn

Rather simple. If the toggle swap is on, we space the playbin ingredient’s express to playing. In any other case, we space the playbin ingredient’s express to paused.

Environment the amount

  _ <- GI.Gtk.onScaleButtonValueChanged volumeButton $
       volume -> void $ Records.GI.Hideous.Properties.setObjectPropertyDouble playbin "volume" volume

Whenever the amount widget stage changes, we forward this stage on to GStreamer in direct that it can presumably per chance well alter the video volume.

Plan

  seekScaleHandlerId <- GI.Gtk.onRangeValueChanged seekScale $ elevate out
    (couldQueryDuration, duration) <- GI.Gst.elementQueryDuration playbin GI.Gst.FormatTime

    when couldQueryDuration $ elevate out
      share' <- GI.Gtk.rangeGetValue seekScale
      let share = share' / A hundred.zero
      let plan = fromIntegral (round ((fromIntegral duration :: Double) * share) :: Int) :: Int64
      void $ GI.Gst.elementSeekSimple playbin GI.Gst.FormatTime [GI.Gst.SeekFlagsFlush ] plan

Film Monad comes with a look scale the place as you scurry the slider forwards or backwards, you progress forwards or backwards thru the video’s frames.

The scale of the look slider is from zero to A hundred and represents the share of video time passed. Advancing the slider to explain 50, will switch the video to the time marker that is half plot between open up and place. We could presumably per chance well also space the slider’s scale to be from zero to alternatively prolonged the video is but this plot lets in us to generalize better.

Trace that for this callback, we take care of across the tag ID (seekScaleHandlerId) since we can need it later.

Plan Scale change

  _ <- GI.GLib.timeoutAddSeconds GI.GLib.PRIORITY_DEFAULT 1 $ elevate out
    (couldQueryDuration, duration) <- GI.Gst.elementQueryDuration playbin GI.Gst.FormatTime
    (couldQueryPosition, plan) <- GI.Gst.elementQueryPosition playbin GI.Gst.FormatTime

    let share =
          if couldQueryDuration && couldQueryPosition && duration > zero
            then A hundred.zero * (fromIntegral plan / fromIntegral duration :: Double)
            else zero.zero

    GI.GObject.signalHandlerBlock seekScale seekScaleHandlerId
    GI.Gtk.rangeSetValue seekScale share
    GI.GObject.signalHandlerUnblock seekScale seekScaleHandlerId

    return Factual

To take care of the look scale in sync with the video’s progress, we must play messenger between GTK+ and GStreamer. Every 2nd, we interrogate the video’s latest plan and change the look scale to ascertain. By doing this, the particular person will know how far along they are and in the occasion that they slump to lag the seeker, this will presumably per chance well be in the coolest express.

As to no longer trigger the callback we setup earlier, we disable the onRangeValueChanged tag handler while we change the look scale. The onRangeValueChanged callback ought to most fantastic sprint if the particular person changes the look slider.

Changing the video dimension

  _ <- GI.Gtk.onComboBoxChanged desiredVideoWidthComboBox $ elevate out
    filename' <- GI.Gtk.fileChooserGetFilename fileChooserButton
    let filename = fromMaybe "" filename'

    desiredVideoWidth <- getDesiredVideoWidth desiredVideoWidthComboBox
    (success, width, high) <- getWindowSize desiredVideoWidth filename

    if success
      then setWindowSize width high fileChooserButton drawingArea window
      else resetWindowSize desiredVideoWidth fileChooserButton drawingArea window

This widget lets the particular person get out the specified width of the video. The tip of the window shall be space in accordance with the aspect ratio of the video and the particular person’s width option.

About

  _ <- GI.Gtk.onWidgetButtonReleaseEvent aboutButton $  _ -> elevate out
    _ <- GI.Gtk.onDialogResponse aboutDialog ( _ -> GI.Gtk.widgetHide aboutDialog)
    void $ GI.Gtk.dialogRun aboutDialog
    return Factual

The final widget we can quilt is the about dialog window. Here we wire up the about dialog window to the about button shown on the most considerable window.

Teardown

  _ <- GI.Gtk.onWidgetDestroy window $ elevate out
    _ <- GI.Gst.elementSetState playbin GI.Gst.StateNull
    _ <- GI.Gst.objectUnref playbin
    GI.Gtk.mainQuit

When the particular person destroys the window, raze the playbin pipeline and quit the most considerable GTK loop.

Startup

  GI.Gtk.widgetShowAll window
  GI.Gtk.most considerable

At prolonged final we repeat or render the most considerable window and fire up the most considerable GTK+ loop. This loop will block unless mainQuit is known as.

The total Predominant.hs file

Under is the movie-monad/src/Predominant.hs file. Different portions no longer covered are diversified utility capabilities that dry up most considerable.

{-
  Film Monad
  (C) 2017 David lettier
  lettier.com
-}

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

module Predominant the place

import Prelude
import International.C.Kinds
import Machine.Project
import Machine.Exit
import Preserve a watch on.Monad
import Preserve a watch on.Exception
import Records.Perchance
import Records.Int
import Records.Text
import Records.String.Utils
import Records.GI.Hideous
import Records.GI.Hideous.Properties
import GI.GLib
import GI.GObject
import certified GI.Gtk
import GI.Gst
import GI.GstVideo
import GI.GdkX11
import Paths_movie_monad

-- Expose Element a form occasion of IsVideoOverlay through a newtype wrapper
-- Our GStreamer ingredient is playbin
-- Playbin implements the GStreamer VideoOverlay interface
newtype GstElement = GstElement GI.Gst.Element
occasion GI.GstVideo.IsVideoOverlay GstElement

most considerable :: IO ()
most considerable = elevate out
  _ <- GI.Gst.init Nothing
  _ <- GI.Gtk.init Nothing

  gladeFile <- getDataFileName "files/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-place"
  seekScale <- builderGetObject GI.Gtk.Scale builder "look-scale"
  onOffSwitch <- builderGetObject GI.Gtk.Switch builder "on-off-swap"
  volumeButton <- builderGetObject GI.Gtk.VolumeButton builder "volume-button"
  desiredVideoWidthComboBox <- builderGetObject GI.Gtk.ComboBoxText builder "desired-video-width-combo-field"
  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" (Correct "MultimediaPlayer")

  _ <- GI.Gtk.onWidgetRealize drawingArea $ elevate out
    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.onFileChooserButtonFileSet fileChooserButton $ elevate out
    _ <- GI.Gst.elementSetState playbin GI.Gst.StateNull

    filename <- fromJust <$> GI.Gtk.fileChooserGetFilename fileChooserButton
    let uri = "file://" ++ filename

    volume <- GI.Gtk.scaleButtonGetValue volumeButton
    Records.GI.Hideous.Properties.setObjectPropertyDouble playbin "volume" volume
    Records.GI.Hideous.Properties.setObjectPropertyString playbin "uri" (Correct $ pack uri)

    desiredVideoWidth <- getDesiredVideoWidth desiredVideoWidthComboBox
    (success, width, high) <- getWindowSize desiredVideoWidth filename

    if success
      then elevate out
        _ <- GI.Gst.elementSetState playbin GI.Gst.StatePlaying
        GI.Gtk.switchSetActive onOffSwitch Factual
        setWindowSize width high fileChooserButton drawingArea window
      else elevate out
        _ <- GI.Gst.elementSetState playbin GI.Gst.StatePaused
        GI.Gtk.switchSetActive onOffSwitch Unsuitable
        resetWindowSize desiredVideoWidth fileChooserButton drawingArea window
        _ <- GI.Gtk.onDialogResponse errorMessageDialog ( _ -> GI.Gtk.widgetHide errorMessageDialog)
        void $ GI.Gtk.dialogRun errorMessageDialog

  _ <- GI.Gtk.onSwitchStateSet onOffSwitch $  switchOn -> elevate out
    if switchOn
      then void $ GI.Gst.elementSetState playbin GI.Gst.StatePlaying
      else void $ GI.Gst.elementSetState playbin GI.Gst.StatePaused
    return switchOn

  _ <- GI.Gtk.onScaleButtonValueChanged volumeButton $
       volume -> void $ Records.GI.Hideous.Properties.setObjectPropertyDouble playbin "volume" volume

  seekScaleHandlerId <- GI.Gtk.onRangeValueChanged seekScale $ elevate out
    (couldQueryDuration, duration) <- GI.Gst.elementQueryDuration playbin GI.Gst.FormatTime

    when couldQueryDuration $ elevate out
      share' <- GI.Gtk.rangeGetValue seekScale
      let share = share' / A hundred.zero
      let plan = fromIntegral (round ((fromIntegral duration :: Double) * share) :: Int) :: Int64
      void $ GI.Gst.elementSeekSimple playbin GI.Gst.FormatTime [GI.Gst.SeekFlagsFlush ] plan

  _ <- GI.GLib.timeoutAddSeconds GI.GLib.PRIORITY_DEFAULT 1 $ elevate out
    (couldQueryDuration, duration) <- GI.Gst.elementQueryDuration playbin GI.Gst.FormatTime
    (couldQueryPosition, plan) <- GI.Gst.elementQueryPosition playbin GI.Gst.FormatTime

    let share =
          if couldQueryDuration && couldQueryPosition && duration > zero
            then A hundred.zero * (fromIntegral plan / fromIntegral duration :: Double)
            else zero.zero

    GI.GObject.signalHandlerBlock seekScale seekScaleHandlerId
    GI.Gtk.rangeSetValue seekScale share
    GI.GObject.signalHandlerUnblock seekScale seekScaleHandlerId

    return Factual

  _ <- GI.Gtk.onComboBoxChanged desiredVideoWidthComboBox $ elevate out
    filename' <- GI.Gtk.fileChooserGetFilename fileChooserButton
    let filename = fromMaybe "" filename'

    desiredVideoWidth <- getDesiredVideoWidth desiredVideoWidthComboBox
    (success, width, high) <- getWindowSize desiredVideoWidth filename

    if success
      then setWindowSize width high fileChooserButton drawingArea window
      else resetWindowSize desiredVideoWidth fileChooserButton drawingArea window

  _ <- GI.Gtk.onWidgetButtonReleaseEvent aboutButton $  _ -> elevate out
    _ <- GI.Gtk.onDialogResponse aboutDialog ( _ -> GI.Gtk.widgetHide aboutDialog)
    void $ GI.Gtk.dialogRun aboutDialog
    return Factual

  _ <- GI.Gtk.onWidgetDestroy window $ elevate out
    _ <- GI.Gst.elementSetState playbin GI.Gst.StateNull
    _ <- GI.Gst.objectUnref playbin
    GI.Gtk.mainQuit

  GI.Gtk.widgetShowAll window
  GI.Gtk.most considerable

builderGetObject ::
  (GI.GObject.GObject b, GI.Gtk.IsBuilder a) =>
  (Records.GI.Hideous.ManagedPtr b -> b) ->
  a ->
  Prelude.String ->
  IO b
builderGetObject objectTypeClass builder objectId =
  fromJust <$> GI.Gtk.builderGetObject builder (pack objectId) >>=
    GI.Gtk.unsafeCastTo objectTypeClass

getVideoInfo :: Prelude.String -> Prelude.String -> IO (Bool, Prelude.String)
getVideoInfo flag filename = elevate out
  (code, out, _) <- take (
      readProcessWithExitCode
        "exiftool"
        [flag"-s", "-S", filename]
        ""
    ) ( (_ :: Preserve a watch on.Exception.IOException) -> return (ExitFailure 1, "", ""))
  return (code == Machine.Exit.ExitSuccess, out)

isVideo :: Prelude.String -> IO Bool
isVideo filename = elevate out
  (success, out) <- getVideoInfo "-MIMEType" filename
  return (success && isInfixOf "video" (pack out))

getWindowSize :: Int -> Prelude.String -> IO (Bool, Int32, Int32)
getWindowSize desiredVideoWidth filename = elevate out
  let defaultWidth = 800
  let defaultHeight = 600

  video <- isVideo filename

  if video
    then elevate out
      (success, out) <- getVideoInfo "-ImageSize" filename
      if success && isInfixOf "x" (pack out)
        then elevate out
          let (width''':high''':_) =
                Records.String.Utils.break up "x" $ Records.String.Utils.strip out

          let width'' = read width''' :: Int
          let high'' = read high''' :: Int

          let ratio = fromIntegral high'' / fromIntegral width'' :: Double
          let width' = fromIntegral desiredVideoWidth :: Double
          let high' = width' * ratio
          let width = fromIntegral (round width' :: Int) :: Int32
          let high = fromIntegral (round high' :: Int) :: Int32

          return (Factual, width, high)
        else return (Unsuitable, defaultHeight, defaultWidth)
    else return (Unsuitable, defaultHeight, defaultWidth)

getDesiredVideoWidth :: GI.Gtk.ComboBoxText -> IO Int
getDesiredVideoWidth = fmap ( x -> read (Records.Text.unpack x) :: Int) . GI.Gtk.comboBoxTextGetActiveText

setWindowSize ::
  Int32 ->
  Int32 ->
  GI.Gtk.FileChooserButton ->
  GI.Gtk.Widget ->
  GI.Gtk.Window ->
  IO ()
setWindowSize width high fileChooserButton drawingArea window = elevate out
  GI.Gtk.setWidgetWidthRequest fileChooserButton width

  GI.Gtk.setWidgetWidthRequest drawingArea width
  GI.Gtk.setWidgetHeightRequest drawingArea high

  GI.Gtk.setWidgetWidthRequest window width
  GI.Gtk.setWidgetHeightRequest window high
  GI.Gtk.windowResize window width (if high <= zero then 1 else high)

resetWindowSize ::
  (Integral a) =>
  a ->
  GI.Gtk.FileChooserButton ->
  GI.Gtk.Widget ->
  GI.Gtk.Window ->
  IO ()
resetWindowSize width' fileChooserButton drawingArea window = elevate out
  let width = fromIntegral width' :: Int32
  setWindowSize width zero fileChooserButton drawingArea window

Constructing Film Monad

Now that now we possess setup our fabricate atmosphere and possess all the source code in plan, we can fabricate Film Monad and sprint the executable/binary.

cd movie-monad/
stack apt
stack fabricate --pedantic
stack install
movie-monad # Or when you eradicate `stack exec -- movie-monad`

If all is in dispute, Film Monad ought to sprint.

Wrap-up

Revisiting the Film Monad accomplishing, we remade the applying the usage of the utility libraries GTK+ and GStreamer. By the usage of GTK+ and GStreamer, the applying stays as moveable as the Electron version. Film Monad can now take care of sizable video files and is derived with all the long-established controls one would demand.

Another support to the GTK+ plot is the smaller footprint. Comparing the resident dimension in reminiscence on open up up, the GTK+ version most fantastic requires ~50 MB while the Electron version requires ~300 MB (a 500% enlarge).

In the tip, the GTK+ plot got here with fewer boundaries and required much less engineering. To present the identical efficiency, the Electron plot would require a unhurried client server structure. Then again, as a result of glorious haskell-gi bindings, we were able to steer clear of the get hang of-basically basically basically based plot altogether.

Must you will want to explore but one more GTK+ application constructed with Haskell, make wonderful that to checkout Gifcurry. Gifcurry lets in you’re taking video files and fabricate GIFs optionally overlaid with textual instruct material.

Be taught More

What do you think?

0 points
Upvote Downvote

Total votes: 0

Upvotes: 0

Upvotes percentage: 0.000000%

Downvotes: 0

Downvotes percentage: 0.000000%