Haskellを使用してGTKビデオプレーヤーを作成する

最後にMovie Monadに立ち寄ったとき、すべてのWebテクノロジー（HTML、CSS、JavaScript、およびElectron）を使用してデスクトップビデオプレーヤーを作成しました。 秘Theは、プロジェクトのすべてのソースコードがHaskellで書かれていることでした。

Webアプローチの制限の1つは、ビデオファイルのサイズが大きくなりすぎないことでした。さもないと、アプリケーションがクラッシュしました。 これを回避するために、ファイルサイズの検証を実装し、制限を超えることについてユーザーに警告しました。

ビデオファイルをHTML5サーバーにストリーミングするバックエンドをセットアップし、サーバーとElectronアプリケーションを並行して実行し、Webを使用したアプローチの開発を続けることができます。 代わりに、Webテクノロジーを放棄し、GTK +、Gstreamer、およびX11ウィンドウシステムを使用します。

Wayland、Quartz、WinAPIなどの別のウィンドウ管理システムを使用する場合、このアプローチをGDKバックエンドで動作するように適合させることができます。 適応は、 GStreamer playbinビデオ出力をMovie Monadウィンドウに埋め込むことです。

GDKはGTK +移植性の重要な側面です。 Glibはすでに低レベルのクロスプラットフォーム機能を提供しているため、GTK +を他のプラットフォームで動作させるためには、GDKをオペレーティングシステムの基本的なグラフィックレベルに移植するだけです。 つまり、GTK +アプリケーションをWindowsおよびmacOS（ ソース ）で実行できるようにするのは、Windows APIおよびQuartzのGDKポートです。

この記事の対象者

• GTK +ユーザーインターフェイスを実装するHaskellプログラマー向け。
• 関数型プログラミングに興味のあるプログラマ向け。
• GUIの作成者向け。
• GitHub Electronの代替品を探している人向け。
• ビデオプレーヤーのファン向け。

検討すること

• スタック。
• Haskell-giバインディング
• さまざまなデータとそれらのファイルのディレクトリ。
• 空き地
• GTK +。
• Gstreamer。
• Movie Monadの作成方法。

プロジェクトのセットアップ

最初に、Haskellプログラムを開発するためにマシンを構成し、プロジェクトディレクトリのファイルと依存関係を構成する必要があります。

Haskellプラットフォーム

マシンがまだHaskellプログラムを開発する準備が整っていない場合は、Haskellプラットフォームをダウンロードしてインストールすることで、必要なものをすべて入手できます 。

スタック

Stackをまだお持ちでない場合は、開発を開始する前に必ずStackをインストールしてください。 ただし、既にHaskellプラットフォームを使用している場合は、すでにStackがあります。

Exiftool

Movie Monadでビデオを再生する前に、ユーザーが選択したファイルに関する情報を収集する必要があります。 これにはExifToolを使用します。 Linuxで作業している場合は、このツール（ which exiftool ）がすでにある可能性があります。 ExifToolは、Windows、Mac、およびLinuxで使用できます。

プロジェクトファイル

プロジェクトファイルを取得するには、3つの方法があります。

 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/ 

SSHを使用してgitクローンを作成できます。

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

HTTPS経由でgitのクローンを作成できます。

ハスケルギ

haskell-giは 、自己診断用のミドルウェアGObject（イントロスペクションミドルウェア）を使用して、Haskellバインディングをライブラリに生成できます。 執筆時点では、必要なバインディングはすべてHackageで利用できます。

依存関係

次に、プロジェクトの依存関係をインストールします。

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

コード

次に、Movie Monadの実装をカスタマイズします。 ソースファイルを削除して再作成するか、指示に従ってください。

Paths_movie_monad.hs

Paths_movie_monad.hs 、実行時にGlade XML GUIファイルを見つけるために使用されます。 開発中なので、ダミーモジュール（ movie-monad/src/dev/Paths_movie_monad.hs ）を使用してmovie-monad/src/data/gui.glade movie-monad/src/dev/Paths_movie_monad.hs movie-monad/src/data/gui.gladeを検索しmovie-monad/src/data/gui.glade 。 プロジェクトをビルド/インストールすると、実際のPaths_movie_monadモジュールが自動的に生成されます。 getDataFileName関数が提供されます。 出力データに、 data-dir (movie-monad/src/) data-filesコピーまたはインストールされる絶対パスの形式でプレフィックスを割り当て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を接続し、ユーザーが終了するとウィンドウを破壊します。

プラグマ

オーバーロードされた文字列とレキシカルスコープの型変数が必要であることをコンパイラー（GHC）に伝える必要があります。

OverloadedStringsを使用すると、 String/[Char]またはTextが必要な場所で、 String/[Char]列リテラル（ "Literal" ）を使用できます。 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 

Cバインディングを使用するため、この言語に既に存在する型を使用する必要があります。 インポートの大部分は、haskell-giによって生成されたバインディングです。

IsVideoOverlay

GStreamerビデオgi-gstvideo （ gi-gstvideo ）には、タイプ（インターフェイス） IsVideoOverlayクラスが含まれています。 GStreamerバインディング（ gi-gst ）には要素タイプが含まれます。 playbin関数でplaybin要素を使用するには、 playbin型（型インスタンス） IsVideoOverlayインスタンスを宣言する必要があります。 また、C側では、 playbinはVideoOverlayインターフェイスを実装します。

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

haskell-giバインディングの外部でインスタンスを宣言する際に、失われた（孤立した）インスタンスの出現を避けるために、 GI.Gst.Elementを新しい型（newtype）でラップすることに注意してください。

メイン

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" 

すでに述べたように、すべてのGUIウィジェットを記述するdata/gui.glade XMLファイルへの絶対パスを取得します。 次に、このファイルからコンストラクターを作成し、ウィジェットを取得します。 Gladeを使用していなかった場合は、手動で作成する必要があり、かなり面倒です。

プレイビン

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

ここでは、 playbin GStreamerパイプラインを作成します。 さまざまなニーズを解決するように設計されており、独自のコンベアを作成する時間を節約できます。 この要素をMultimediaPlayer呼びます。

GStreamer出力の埋め込み

GTK +とGStreamerを連​​携させるには、GStreamerにビデオの正確な出力先を指示する必要があります。 これを行わないと、 playbinを使用するため、GStreamerは独自のウィンドウを作成します。

  _ <- 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ウィジェットのdrawingAreaがdrawingAreaたときのコールバックのセットアップが表示されます。 GStreamerがビデオを表示するのはこのウィジェットです。 レンダーエリアウィジェットの親GDKウィンドウを取得します。 次に、ウィンドウハンドラー、またはGTK +ウィンドウのX11システムのXIDを取得します。 文字列CUIntPtrはIDをCULongからCULongに変換します。これはCUIntPtrに必要です。 正しい型を受け取っplaybin 、 xid'ハンドラーの助けを借りて、ウィンドウにplaybinの出力を描画できることをplaybinせます。

Gladeのバグにより、プログラムでフルスクリーンウィジェットを非表示にします。Gladeの表示ボックスをオフにしても、ウィジェットは非表示にならないためです。

Xシステムではなく他のシステムを使用している場合は、ここで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ます。
• ウィジェットの音量レベルをplaybinと同じにしplaybin 。
• 目的の画像の幅とビデオのサイズに基づいて、ウィンドウの適切な幅と高さを決定します。
• ウィンドウの寸法が正常に受信された場合：
  
  • ファイルの再生を開始します。
  • 一時停止/再生ボタンを「オン」状態に設定します。
  • 全画面ウィジェットを表示します。
  • ビデオが全画面表示でない場合：
  • ビデオの相対サイズに一致するようにウィンドウのサイズを変更します。
• ウィンドウの寸法を取得できなかった場合：
  
  • playbin 。
  • スイッチを「オフ」の位置に回します。
  • 可能であれば、ウィンドウを全画面モードから解除します。
  • ウィンドウサイズをリセットします。
  • 小さなダイアログエラーメッセージを表示します。

一時停止して再生

  _ <- 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 

すべてがシンプルです。 スイッチが「オン」の位置にある場合、 playbin要素を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を無効にします。 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はありません。 したがって、可変リンクを使用します。

メインスレッドで1つのライターとヒープのシグナルコールバックを使用することにより、一般的な可変状態のトラップを回避できます。 実行スレッドの安全性が心配な場合は、代わりに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 

問題の最後のウィジェットは、Aboutダイアログです。 ここでは、ダイアログボックスをメインウィンドウに表示される[About]ボタンに関連付けます。

ウィンドウを閉じる

  _ <- 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 . .