Когда мы в последний раз остановились на Movie Monad, мы создали десктопный видео-плеер, использующий все веб-технологии (HTML, CSS, JavaScript и Electron). Фокус был в том, что весь исходный код проекта был написан на Haskell.
Одним из ограничений нашего веб-подхода было то, что размер видео-файла не мог быть слишком большим, в противном случае приложение падало. Чтобы этого избежать, мы внедрили проверку размера файла и предупреждали пользователя о превышении ограничения.
Мы могли бы продолжить развивать наш подход с вебом, настроив бэкенд на стриминг видеофайла в HTML5-сервер, запустив параллельно сервер и Electron-приложение. Вместо этого мы откажемся от веб-технологий и обратимся к GTK+, Gstreamer и системе управления окнами X11.
Если вы используете другую систему управления окнами, например, Wayland, Quartz или WinAPI, то этот подход может быть адаптирован для работы с вашим GDK-бэкендом. Адаптация заключается во встраивании выходного видеосигнала GStreamer playbin в окно Movie Monad.
GDK — важный аспект портируемости GTK+. Поскольку Glib уже предоставляет низкоуровневую кроссплатформенную функциональность, то чтобы заставить GTK+ работать на других платформах вам нужно только портировать GDK на базовый графический уровень операционной системы. То есть именно GDK-порты на Windows API и Quartz позволяют приложениям GTK+ исполняться на Windows и macOS (источник).
Для кого эта статья
- Для программистов на Haskell, которые хотят реализовать пользовательский интерфейс на GTK+.
- Для программистов, интересующихся функциональным программированием.
- Для создателей GUI.
- Для тех, кто ищет альтернативы GitHub Electron.
- Для фанатов видео-плееров.
Что мы рассмотрим
- Stack.
- Привязки (bindings) haskell-gi
- Директорию различных данных и файлы с ними.
- Glade.
- GTK+.
- GStreamer.
- Как создать Movie Monad.
Настройка проекта
Сначала нам нужно настроить машину для разработки Haskell-программ, а также настроить файлы и зависимости для директории проекта.
Платформа Haskell
Если ваша машина ещё не готова к разработке Haskell-программ, то всё необходимое вы можете получить, скачав и установив платформу Haskell.
Stack
Если у вас ещё нет Stack, то обязательно установите его, прежде чем приступать к разработке. Но если вы уже пользовались платформой Haskell, то Stack у вас уже есть.
ExifTool
Прежде чем проигрывать видео в Movie Monad, нам нужно собрать кое-какую информацию о выбранном пользователем файле. Для этого воспользуемся ExifTool. Если вы работаете под Linux, то велик шанс, что у вас уже есть этот инструмент (which exiftool
). ExifTool доступен для Windows, Mac и Linux.
Файлы проекта
Есть три способа получения файлов проекта.
wget https://github.com/lettier/movie-monad/archive/master.zip
unzip master.zip
mv movie-monad-master movie-monad
cd movie-monad/
Можете скачать ZIP-архив и извлечь их.
git clone git@github.com:lettier/movie-monad.git
cd movie-monad/
Можете сделать Git-клон с помощью SSH.
git clone https://github.com/lettier/movie-monad.git
cd movie-monad/
Можете склонировать git через HTTPS.
haskell-gi
haskell-gi умеет генерировать Haskell-привязки (bindings) к библиотекам, использующим связующее ПО для самодиагностики (introspection middleware) GObject. На момент написания статьи все необходимые привязки доступны на Hackage.
Зависимости
Теперь устанавливаем зависимости проекта.
cd movie-monad/
stack install --dependencies-only
Код
Теперь настраиваем внедрение Movie Monad. Вы можете удалить исходные файлы и создать их заново, или следовать указаниям.
Paths_movie_monad.hs
Paths_movie_monad.hs
используется для поиска файла Glade XML GUI во время runtime. Поскольку мы занимаемся разработкой, то будем использовать фиктивный модуль (dummy module) (movie-monad/src/dev/Paths_movie_monad.hs
) для поиска файла movie-monad/src/data/gui.glade
. После сборки/установки проекта реальный модуль Paths_movie_monad
будет сгенерирован автоматически. Он предоставит нам функцию getDataFileName
. Она присваивает своим выходным данным префикс в виде абсолютного пути, куда скопированы или установлены data-dir (movie-monad/src/) data-files
.
{-# 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)
Фиктивный модуль 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)
Автоматически сгенерированный модуль Paths_movie_monad
.
Main.hs
Main.hs
— это входная точка для Movie Monad. В этом файле мы настраиваем наше окно с разными виджетами, подключаем GStreamer, а когда пользователь выходит, мы сносим окно.
Прагмы (Pragmas)
Нам нужно сказать компилятору (GHC), что нам нужны перегруженные (overloaded) строковые и лексически входящие в область видимости (lexically scoped) переменные типов. OverloadedStrings
позволяет нам использовать строковые литералы ("Literal"
) там, где требуются String/[Char]
или Text. ScopedTypeVariables
позволяет нам использовать сигнатуру типа в паттерне параметра лямбда-функции, передаваемую для перехвата при вызове ExifTool.
{-# 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
Поскольку мы работает с привязками Си, нам понадобится работать с типами, уже существующими в этом языке. Немалую часть импортов составляют привязки, генерируемые haskell-gi.
IsVideoOverlay
GStreamer-видеопривязки (gi-gstvideo
) содержат класс типа (интерфейс) IsVideoOverlay
. GStreamer-привязки (gi-gst
) содержат тип элемента. Чтобы использовать элемент playbin
с функцией GI.GstVideo.videoOverlaySetWindowHandle
, нам нужно объявить GI.Gst.Element
— экземпляр типа (type instance) IsVideoOverlay
. А на стороне Cи playbin
реализует интерфейс VideoOverlay
.
newtype GstElement = GstElement GI.Gst.Element
instance GI.GstVideo.IsVideoOverlay GstElement
Обратите внимание, что мы обёртываем GI.Gst.Element
в новый тип (newtype), чтобы избежать появления потерянного (orphaned) экземпляра, поскольку мы объявляем экземпляр вне привязок haskell-gi.
main
Main
— наша самая большая функция. В ней мы инициализируем все GUI-виджеты и определяем коллбэк-процедуры на основе определённых событий.
main :: IO ()
main = do
GI-инициализация
_ <- GI.Gst.init Nothing
_ <- GI.Gtk.init Nothing
Здесь мы инициализировали GStreamer и GTK+.
Сборка GUI-виджетов
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"
Как уже было сказано, мы получаем абсолютный путь к XML-файлу data/gui.glade
, который описывает все наши GUI-виджеты. Дальше создаём из этого файла конструктор и получаем свои виджеты. Если бы мы не использовали Glade, то их пришлось бы создавать вручную, что довольно утомительно.
Playbin
playbin <- fromJust <$> GI.Gst.elementFactoryMake "playbin" (Just "MultimediaPlayer")
Здесь мы создаём GStreamer-конвейер playbin
. Он предназначен для решения самых разных нужд и экономит нам время на создании собственного конвейера. Назовём этот элемент MultimediaPlayer
.
Встраиванние выходных данных GStreamer
Чтобы GTK+ и GStreamer заработали вместе, нам нужно сказать GStreamer, куда именно нужно выводить видео. Если этого не сделать, то GStreamer создаст собственное окно, поскольку мы используем 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
Здесь вы видите настройку коллбэка по мере готовности виджета drawingArea
. Именно в этом виджете GStreamer должен показывать видео. Мы получаем родительское GDK-окно для виджета области отрисовки. Затем получаем обработчик окна, или XID
системы X11 нашего окна GTK+. Строка CUIntPtr
преобразует ID из CULong
в CUIntPtr
, необходимый для videoOverlaySetWindowHandle
. Получив правильный тип, мы уведомляем GStreamer, что с помощью обработчика xid'
он может отрисовывать в нашем окне выходные данные playbin
.
Из-за бага в Glade мы программно скрываем полноэкранный виджет, поскольку если в Glade снять галочку visible box, то виджет всё-равно не будет спрятан.
Обратите внимание, что здесь нужно адаптировать Movie Monad для работы с оконной системой, если вы используете не Х-систему, а какую-то другую.
Выбор файла
_ <- 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
Для начала сессии проигрывания видео, пользователь должен иметь возможность выбрать видео-файл. После того, как файл выбран, нужно выполнить ряд обязательных действий, чтобы всё работало хорошо.
- Получаем имя файла из виджета выбора файла.
- Говорим
playbin
, какой файл он должен воспроизвести. - Делаем уровень громкомсти в виджете таким же, как в
playbin
. - На основе желаемой ширины изображения и размера видео определяем подходящие ширину и высоту окна.
- Если размеры окна успешно получены:
- Начинаем воспроизведение файла.
- Переводим кнопку пауза/воспроизведение в состояние ”on”.
- Показываем полноэкранный виджет.
- Если видео не в полноэкранном режиме:
- Меняем размер окна, чтобы оно совпало с относительным размером видео.
- Если не удалось получить размеры окна:
- Ставим
playbin
на паузу. - Переводим переключатель в положение ”off”.
- Если это возможно, выводим окно из полноэкранного режима.
- Сбрасываем размер окна.
- Выводим маленькое диалоговое сообщение об ошибке.
- Ставим
Пауза и воспроизведение
_ <- 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
Всё просто. Если переключатель в положении ”on”, то задаём элементу playbin
состояние воспроизведения. В противном случае задаём ему состояние паузы.
Настройка громкости
_ <- GI.Gtk.onScaleButtonValueChanged volumeButton (onScaleButtonValueChanged playbin)
-- ...
onScaleButtonValueChanged ::
GI.Gst.Element ->
Double ->
IO ()
onScaleButtonValueChanged playbin volume =
void $ Data.GI.Base.Properties.setObjectPropertyDouble playbin "volume" volume
При изменении уровня громкости в виджете мы передаём его значение в GStreamer, чтобы тот мог подстроить громкость воспроизведение.
Перемещение по видео
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
В Movie Monad есть шкала воспроизведения, в которой вы можете перемещать ползунок вперёд/назад, тем самым переходя по видеофреймам.
Шкала от 0 до 100% представляет общую длительность видео-файла. Если переместить ползунок, например, на 50, то мы перейдём к временной отметке, находящийся посередине между началом и окончанием. Можно было бы настроить шкалу от нуля до значения длительности видео, но описанный метод более универсален.
Обратите внимание, что для этого коллбэка мы используем сигнальный ID (seekScaleHandlerId
), поскольку он понадобится нам позднее.
Обновление шкалы воспроизведения
_ <- 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
Чтобы синхронизировать шкалу и сам процесс воспроизведения видео, нужно передавать сообщения между GTK+ и GStreamer. Каждую секунду мы будем запрашивать текущую позицию воспроизведения и в соответствии с ней обновлять шкалу. Так мы показываем пользователю, какая часть файла уже показана, а ползунок всегда будет соответствовать реальной позиции воспроизведения.
Чтобы не инициировать настроенный ранее коллбэк, мы отключаем обработчик сигнала onRangeValueChanged
при обновлении шкалы воспроизведения. Коллбэк onRangeValueChanged
должен быть выполнен только если пользователь изменит положение ползунка.
Изменение размеров видео
_ <- 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
Этот виджет позволяет пользователю выбирать желаемую ширину видео. Высота будет подобрана автоматически на основе соотношения сторон видеофайла.
Полноэкранный режим
_ <- 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
Когда пользователь отпускает кнопку виджета полноэкранного режим, мы переключаем состояние полноэкранного режима окна, скрываем панель выбора файла и виджет выбора ширины видео. При выходе из полноэкранного режима мы восстанавливаем панель и виджет.
Обратите внимание, что мы не показываем виджет полноэкранного режима, если у нас нет видео.
_ <- 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
Для управления полноэкранным состоянием окна мы должны настроить коллбэк, чтобы он запускался при каждом изменении состояния окна. От информации о состоянии полноэкранности окна зависят различные коллбэки. В качестве помощи воспользуемся IORef
, из которого будет читать каждая функция и в который будет писать коллбэк. Этот IORef
является изменяемой (и общей) ссылкой. В идеале нам нужно запрашивать окно именно в то время, когда оно находится в полноэкранном режиме, но для этого не существует API. Поэтому будем использовать изменяемую ссылку.
Благодаря использованию в главном потоке выполнения единственного пишущего и кучи сигнальных коллбэков, мы избегаем возможных ловушек общего изменяемого состояния. Если бы нас заботила безопасность потока выполнения, то вместо этого мы могли бы использовать MVar
, TVar
или atomicModifyIORef
.
О программе
_ <- 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
Последний рассматриваемый виджет — диалоговое окно «О программе». Здесь мы связываем диалоговое окно с кнопкой «О программе», отображающейся в основном окне.
Закрытие окна
_ <- 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
Когда пользователь закрывает окно, мы уничтожаем конвейер playbin
и выходим из основного цикла GTK.
Запуск
GI.Gtk.widgetShowAll window
GI.Gtk.main
Наконец, мы показываем или отрисовываем главное окно и запускаем основной цикл GTK+. Он блокируется до вызова mainQuit
.
Полный файл Main.hs
Ниже приведён файл movie-monad/src/Main.hs
. Не показаны разные вспомогательные функции, относящиеся к main
.
{-
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 должен запуститься.
Заключение
Пересмотрев проект Movie Monad, мы заново сделали приложение с помощью программных библиотек GTK+ и GStreamer. Благодаря им приложение осталось таким же портируемым, как и Electron-версия. Movie Monad теперь может обрабатывать большие видеофайлы и имеет все стандартные элементы управления.
Другим преимуществом использования GTK+ стало уменьшение потребления памяти. Если сравнивать резидентный размер в памяти при старте, то версия GTK+ занимает ~50 Мб, а версия Electron — ~300 Мб (500%-ное увеличение).
Наконец, вариант с GTK+ имеет меньше ограничений и требует меньше программирования. Для обеспечения такой же функциональности, вариант с Electron требует использования громоздкой клиент-серверной архитектуры. Но благодаря прекрасным сборкам haskell-gi мы смогли избежать решения на базе веба.
Если хотите посмотреть другие приложения, построенные с помощью GTK+ и Haskell, то обратите внимание на Gifcurry. Оно умеет брать видеофайлы и на их основе создавать гифки с наложенным текстом.
Автор: AloneCoder