movie-monad 0.0.3.0 → 0.0.4.0
raw patch · 16 files changed
+257/−38 lines, 16 filesdep +haskell-gi
Dependencies added: haskell-gi
Files
- CHANGELOG.md +19/−0
- README.md +7/−4
- makefile +4/−3
- movie-monad.cabal +10/−3
- src/Constants.hs +1/−1
- src/Keyboard.hs +5/−5
- src/Main.hs +7/−1
- src/Playbin.hs +100/−12
- src/Records.hs +1/−0
- src/SubtitleSelector.hs +48/−0
- src/Utils.hs +7/−1
- src/VideoSizeSelector.hs +1/−3
- src/Window.hs +3/−1
- src/c/gst-ffi.c +14/−0
- src/c/gst-ffi.h +9/−0
- src/data/gui.glade +21/−4
CHANGELOG.md view
@@ -2,6 +2,25 @@ ## CHANGELOG +### 0.0.4.0++#### Added++- Subtitle support+- C src directory+- C FFI files++#### Changed++- Clamped keyboard shortcut seek left and right to 0.0 and 100.0+- Reduced keyboard shortcut seek left and right proportion++#### Removed++-++-------------------------------------------------------------------------------+ ### 0.0.3.0 #### Added
README.md view
@@ -30,6 +30,9 @@ * Seek * Play and Pause * Volume+* Subtitles+ * Disable+ * List and Pick from the Available Languages * Command-line Play * `movie-monad ./path/to/video/file.mp4` * `movie-monad http://www.domain.tld/path/to/video/file.mp4`@@ -104,10 +107,10 @@ # Install GStreamer Bad Plug-ins >= 1.8 (https://gstreamer.freedesktop.org/modules/gst-plugins-bad.html) # Install Wget (https://www.gnu.org/software/wget/) # Visit https://github.com/lettier/movie-monad/releases-# Download the latest AppImage movie-monad-0.0.3.0-x86_64.AppImage-wget https://github.com/lettier/movie-monad/releases/download/0.0.3.0/movie-monad-0.0.3.0-x86_64.AppImage-chmod a+x movie-monad-0.0.3.0-x86_64.AppImage-./movie-monad-0.0.3.0-x86_64.AppImage+# Download the latest AppImage movie-monad-0.0.4.0-x86_64.AppImage+wget https://github.com/lettier/movie-monad/releases/download/0.0.4.0/movie-monad-0.0.4.0-x86_64.AppImage+chmod a+x movie-monad-0.0.4.0-x86_64.AppImage+./movie-monad-0.0.4.0-x86_64.AppImage ``` ##### Install
makefile view
@@ -5,13 +5,14 @@ STACK=stack --allow-different-user STACK_SNAPSHOT_INSTALL_ROOT=`$(STACK) path --snapshot-install-root`+STACK_SNAPSHOT_INSTALL_ROOT_BIN=$(STACK_SNAPSHOT_INSTALL_ROOT)/bin STACK_PATH_LOCAL_BIN=`$(STACK) path --local-bin` STACK_GHC_EXE=`$(STACK) path --compiler-exe` STACK_GHC_BIN=`$(STACK) path --compiler-bin`-STACK_PATHS=$(STACK_PATH_LOCAL_BIN):$(STACK_GHC_BIN):$(STACK_SNAPSHOT_INSTALL_ROOT)-CABAL=env PATH=$(PATH):$(STACK_PATHS) $(STACK_SNAPSHOT_INSTALL_ROOT)/bin/cabal+STACK_PATHS=$(STACK_PATH_LOCAL_BIN):$(STACK_GHC_BIN):$(STACK_SNAPSHOT_INSTALL_ROOT):$(STACK_SNAPSHOT_INSTALL_ROOT_BIN)+CABAL=env PATH=$(PATH):$(STACK_PATHS) $(STACK_SNAPSHOT_INSTALL_ROOT_BIN)/cabal -export PATH := $(PATH):$(STACK_PATH_LOCAL_BIN)+export PATH := $(PATH):$(STACK_PATHS) all: setup build
movie-monad.cabal view
@@ -1,5 +1,5 @@ name: movie-monad-version: 0.0.3.0+version: 0.0.4.0 synopsis: Plays videos using GStreamer and GTK+. description: A free and simple to use video player built with Haskell. homepage: https://github.com/lettier/movie-monad@@ -33,6 +33,7 @@ , ./src/Seek.hs , ./src/PlayPause.hs , ./src/VideoSizeSelector.hs+ , ./src/SubtitleSelector.hs , ./src/Fullscreen.hs , ./src/ErrorMessage.hs , ./src/About.hs@@ -41,6 +42,8 @@ , ./src/Uri.hs , ./src/Utils.hs , ./src/ScreensaverAndPowerManagement.hs+ , ./src/c/gst-ffi.h+ , ./src/c/gst-ffi.c data-files: data/gui.glade , data/movie-monad-logo.svg , data/movie-monad-icon.png@@ -62,6 +65,7 @@ , process == 1.4.* , MissingH == 1.4.* , network-uri == 2.6.*+ , haskell-gi == 0.20.* , haskell-gi-base == 0.20.8 , gi-gobject == 2.0.* , gi-glib == 2.0.*@@ -70,7 +74,6 @@ , gi-gst == 1.0.* , gi-gstvideo == 1.0.* , gi-gtk == 3.0.18- ghc-options: -threaded -with-rtsopts=-N -Wall -freverse-errors other-modules: Paths_movie_monad , Records , Constants@@ -82,6 +85,7 @@ , Seek , PlayPause , VideoSizeSelector+ , SubtitleSelector , Fullscreen , ErrorMessage , About@@ -90,4 +94,7 @@ , Playbin , Utils , ScreensaverAndPowerManagement- hs-source-dirs: ./src/+ hs-source-dirs: ./src/+ includes: ./src/c/gst-ffi.h+ c-sources: ./src/c/gst-ffi.c+ ghc-options: -rtsopts -with-rtsopts=-N -threaded -Wall -freverse-errors
src/Constants.hs view
@@ -17,4 +17,4 @@ invalidVideoWidgetName = "invalid-video-widget" keyboardShortcutSeekAdvanceBy :: Double-keyboardShortcutSeekAdvanceBy = 10.0+keyboardShortcutSeekAdvanceBy = 1.0
src/Keyboard.hs view
@@ -7,7 +7,6 @@ module Keyboard where import Control.Monad-import Data.Fixed import Data.IORef import qualified GI.Gdk import qualified GI.Gtk@@ -18,6 +17,7 @@ import PlayPause import Fullscreen import Constants+import Utils addKeyboardEventHandler :: R.Application -> IO () addKeyboardEventHandler@@ -68,15 +68,15 @@ let newVolume = if oldVolume <= 0.0 then 0.0 else oldVolume - volumeDelta GI.Gtk.scaleButtonSetValue volumeButton newVolume -- Seek left- when (keyValue == GI.Gdk.KEY_Left) $ do+ when (keyValue == GI.Gdk.KEY_Left) $ void $ GI.Gtk.rangeSetValue seekScale- ((rangeValue - keyboardShortcutSeekAdvanceBy) `Data.Fixed.mod'` 100.0)+ (clamp 0.0 100.0 (rangeValue - keyboardShortcutSeekAdvanceBy)) -- Seek right- when (keyValue == GI.Gdk.KEY_Right) $ do+ when (keyValue == GI.Gdk.KEY_Right) $ void $ GI.Gtk.rangeSetValue seekScale- ((rangeValue + keyboardShortcutSeekAdvanceBy) `Data.Fixed.mod'` 100.0)+ (clamp 0.0 100.0 (rangeValue + keyboardShortcutSeekAdvanceBy)) -- Show Controls when (keyValue == GI.Gdk.KEY_c) $ do eventMotion <- GI.Gdk.newZeroEventMotion
src/Main.hs view
@@ -35,6 +35,7 @@ import ErrorMessage import About import VideoSizeSelector+import SubtitleSelector import Playbin import ScreensaverAndPowerManagement (disable, enable) import Utils@@ -71,6 +72,7 @@ pauseImage <- builderGetObject GI.Gtk.Image builder "pause-image" volumeButton <- builderGetObject GI.Gtk.VolumeButton builder "volume-button" videoWidthSelectionComboBox <- builderGetObject GI.Gtk.ComboBoxText builder "video-width-selection-combo-box"+ subtitleSelectionComboBox <- builderGetObject GI.Gtk.ComboBoxText builder "subtitle-selection-combo-box" fullscreenButton <- builderGetObject GI.Gtk.Button builder "fullscreen-button" bufferingSpinner <- builderGetObject GI.Gtk.Spinner builder "buffering-spinner" errorMessageDialog <- builderGetObject GI.Gtk.MessageDialog builder "error-message-dialog"@@ -116,6 +118,8 @@ GI.Gtk.widgetSetVexpand videoWidget True GI.Gtk.widgetSetSensitive videoWidget True + turnOffSubtitles playbin+ playbinBus <- GI.Gst.elementGetBus playbin let guiObjects = R.GuiObjects {@@ -135,6 +139,7 @@ , R.pauseImage = pauseImage , R.volumeButton = volumeButton , R.videoWidthSelectionComboBox = videoWidthSelectionComboBox+ , R.subtitleSelectionComboBox = subtitleSelectionComboBox , R.fullscreenButton = fullscreenButton , R.bufferingSpinner = bufferingSpinner , R.errorMessageDialog = errorMessageDialog@@ -150,11 +155,12 @@ } addWindowHandlers application [playVideoFromCommandLineIfNeeded]- addPlaybinHandler application+ addPlaybinHandlers application addFileChooserHandlers application addPlayPauseButtonClickHandler application addSeekHandlers application addVideoSizeSelectorHandler application+ addSubtitleSelectorHandler application addFullscreenButtonReleaseHandler application addMouseMoveHandlers application [fillWindowWithVideo] addAboutHandler application
src/Playbin.hs view
@@ -4,14 +4,19 @@ lettier.com -} -{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, ForeignFunctionInterface #-} module Playbin where import Control.Monad+import Foreign.C+import Foreign.Ptr+import Data.Bits import Data.Text+import Data.Maybe import Data.GI.Base.Properties-import GI.GLib+import Data.GI.Base.ManagedPtr+import qualified GI.GLib import qualified GI.Gtk import qualified GI.Gst @@ -21,8 +26,11 @@ import ErrorMessage import Uri -addPlaybinHandler :: R.Application -> IO ()-addPlaybinHandler+foreign import ccall "gst-ffi.h get_text_tag_list"+ c_getTextTagList :: Ptr a -> CInt -> IO (Ptr b)++addPlaybinHandlers :: R.Application -> IO ()+addPlaybinHandlers R.Application { R.guiObjects = guiObjects@R.GuiObjects { R.volumeButton = volumeButton@@ -57,6 +65,7 @@ , R.errorMessageDialog = errorMessageDialog , R.bufferingSpinner = bufferingSpinner , R.playPauseButton = playPauseButton+ , R.subtitleSelectionComboBox = subtitleSelectionComboBox } playbin _@@ -69,15 +78,14 @@ entryText <- GI.Gtk.entryGetText fileChooserEntry labelText <- GI.Gtk.labelGetText fileChooserButtonLabel when (- messageType == GI.Gst.MessageTypeError &&- (+ messageType == GI.Gst.MessageTypeError && ( (not . Data.Text.null) entryText || labelText /= "Open" ) ) $ do (gError, text) <- GI.Gst.messageParseError message gErrorText <- GI.Gst.gerrorMessage gError- Prelude.mapM_ print [text, "\n", gErrorText]+ putStr ((Data.Text.unpack . Data.Text.unlines) [text, gErrorText]) GI.Gtk.entrySetText fileChooserEntry "" GI.Gtk.labelSetText fileChooserButtonLabel "Open" _ <- GI.Gst.elementSetState playbin GI.Gst.StateNull@@ -101,6 +109,28 @@ GI.Gtk.widgetSetSensitive seekScale False void $ GI.Gst.elementSetState playbin GI.Gst.StatePaused return ()+ when (messageType == GI.Gst.MessageTypeStreamStart) $ do+ turnOffSubtitles playbin+ nText <- getTextStreamCount playbin+ GI.Gtk.comboBoxTextRemoveAll subtitleSelectionComboBox+ GI.Gtk.comboBoxTextAppend+ subtitleSelectionComboBox+ (Just "-1")+ "None"+ _ <- GI.Gtk.comboBoxSetActiveId subtitleSelectionComboBox (Just "-1")+ GI.Gtk.widgetHide subtitleSelectionComboBox+ when (nText > 0) $+ mapM_ (\ i -> do+ (_, maybeCode) <- getTextTagLanguageNameAndCode playbin i+ case maybeCode of+ Nothing -> return ()+ Just code -> do+ GI.Gtk.widgetShow subtitleSelectionComboBox+ GI.Gtk.comboBoxTextAppend+ subtitleSelectionComboBox+ (Just (Data.Text.pack (show i)))+ code+ ) [0..(nText-1)] return True volumeButtonValueChangedHandler ::@@ -110,13 +140,71 @@ volumeButtonValueChangedHandler playbin volume = void $ Data.GI.Base.Properties.setObjectPropertyDouble playbin "volume" volume -setPlaybinUriAndVolume ::- GI.Gst.Element ->- Prelude.String ->- GI.Gtk.VolumeButton ->- IO ()+setPlaybinUriAndVolume :: GI.Gst.Element -> Prelude.String -> GI.Gtk.VolumeButton -> IO () setPlaybinUriAndVolume playbin fileName volumeButton = do uri <- addUriSchemeIfNone fileName volume <- GI.Gtk.scaleButtonGetValue volumeButton Data.GI.Base.Properties.setObjectPropertyDouble playbin "volume" volume Data.GI.Base.Properties.setObjectPropertyString playbin "uri" (Just $ pack uri)++getTextTagLanguageNameAndCode :: GI.Gst.Element -> Int -> IO (Maybe Text, Maybe Text)+getTextTagLanguageNameAndCode playbin streamId = do+ nText <- getTextStreamCount playbin+ if streamId >= 0 && streamId < nText+ then+ withManagedPtr playbin $ \ playbinPtr -> do+ let streamId' = fromIntegral streamId :: CInt+ tagListPtr <- c_getTextTagList playbinPtr streamId'+ if tagListPtr == nullPtr+ then return (Nothing, Nothing)+ else do+ tagList <- wrapBoxed GI.Gst.TagList tagListPtr+ tagListAsString <- fmap (fromMaybe "") (GI.Gst.tagListToString tagList)+ (successName, name) <- if "language-name" `Data.Text.isInfixOf` tagListAsString+ then GI.Gst.tagListGetString tagList "language-name"+ else return (False, "")+ (successCode, code) <- if "language-code" `Data.Text.isInfixOf` tagListAsString+ then GI.Gst.tagListGetString tagList "language-code"+ else return (False, "")+ return (+ if successName then Just name else Nothing+ , if successCode then Just code else Nothing+ )+ else return (Nothing, Nothing)++turnOnSubtitles :: GI.Gst.Element -> IO ()+turnOnSubtitles playbin = do+ -- Flags "GstPlayFlags" Default: 0x00000617, "soft-colorbalance+deinterlace+soft-volume+text+audio+video"+ -- (0x00000001): video - Render the video stream+ -- (0x00000002): audio - Render the audio stream+ -- (0x00000004): text - Render subtitles+ -- (0x00000008): vis - Render visualisation when no video is present+ -- (0x00000010): soft-volume - Use software volume+ -- (0x00000020): native-audio - Only use native audio formats+ -- (0x00000040): native-video - Only use native video formats+ -- (0x00000080): download - Attempt progressive download buffering+ -- (0x00000100): buffering - Buffer demuxed/parsed data+ -- (0x00000200): deinterlace - Deinterlace video if necessary+ -- (0x00000400): soft-colorbalance - Use software color balance+ -- (0x00000800): force-filters - Force audio/video filter(s) to be applied+ -- 0110 0001 0111+ let flags = flip setBit 10 $ flip setBit 9 $ flip setBit 4 $ flip setBit 2 $ flip setBit 1 $ bit 0+ void $ Data.GI.Base.Properties.setObjectPropertyInt playbin "flags" flags++turnOffSubtitles :: GI.Gst.Element -> IO ()+turnOffSubtitles playbin = do+ let flags = flip setBit 10 $ flip setBit 9 $ flip setBit 4 $ flip setBit 1 $ bit 0+ void $ Data.GI.Base.Properties.setObjectPropertyInt playbin "flags" flags++getTextStreamCount :: GI.Gst.Element -> IO Int+getTextStreamCount playbin =+ Data.GI.Base.Properties.getObjectPropertyInt playbin "n-text"+ >>= \ x -> return (if x < 0 then 0 else fromIntegral x :: Int)++getCurrentTextStreamId :: GI.Gst.Element -> IO Int+getCurrentTextStreamId playbin =+ Data.GI.Base.Properties.getObjectPropertyInt playbin "current-text" >>= \ x -> return (fromIntegral x :: Int)++setCurrentTextStreamId :: GI.Gst.Element -> Int -> IO ()+setCurrentTextStreamId playbin streamId =+ Data.GI.Base.Properties.setObjectPropertyInt playbin "current-text" (fromIntegral streamId :: CInt)
src/Records.hs view
@@ -47,6 +47,7 @@ , pauseImage :: GI.Gtk.Image , volumeButton :: GI.Gtk.VolumeButton , videoWidthSelectionComboBox :: GI.Gtk.ComboBoxText+ , subtitleSelectionComboBox :: GI.Gtk.ComboBoxText , fullscreenButton :: GI.Gtk.Button , bufferingSpinner :: GI.Gtk.Spinner , errorMessageDialog :: GI.Gtk.MessageDialog
+ src/SubtitleSelector.hs view
@@ -0,0 +1,48 @@+{-+ Movie Monad+ (C) 2017 David lettier+ lettier.com+-}++module SubtitleSelector where++import Control.Monad+import Data.Text+import qualified GI.Gtk++import qualified Records as R+import Playbin++addSubtitleSelectorHandler :: R.Application -> IO ()+addSubtitleSelectorHandler+ application@R.Application {+ R.guiObjects = R.GuiObjects {+ R.subtitleSelectionComboBox = subtitleSelectionComboBox+ }+ }+ = void (+ GI.Gtk.onComboBoxChanged+ subtitleSelectionComboBox+ (subtitleSelectorHandler application)+ )++subtitleSelectorHandler :: R.Application -> IO ()+subtitleSelectorHandler+ R.Application {+ R.guiObjects = R.GuiObjects {+ R.subtitleSelectionComboBox = subtitleSelectionComboBox+ }+ , R.playbin = playbin+ }+ = do+ maybeActiveId <- GI.Gtk.getComboBoxActiveId subtitleSelectionComboBox+ nText <- getTextStreamCount playbin+ case maybeActiveId of+ Nothing -> return ()+ Just activeId -> do+ let activeId' = read (Data.Text.unpack activeId) :: Int+ if activeId' == (-1)+ then turnOffSubtitles playbin+ else when (activeId' >= 0 && activeId' < nText) $ do+ setCurrentTextStreamId playbin activeId'+ turnOnSubtitles playbin
src/Utils.hs view
@@ -53,6 +53,12 @@ args "" ) (\ (e :: Control.Exception.IOException) ->- print e >>+ putStr (show e) >> return (ExitFailure 1, "", "") )++clamp :: Ord a => a -> a -> a -> a+clamp minimum' maximum' el+ | el < minimum' = minimum'+ | el > maximum' = maximum'+ | otherwise = el
src/VideoSizeSelector.hs view
@@ -28,9 +28,7 @@ (videoSizeSelectionHandler application) ) -videoSizeSelectionHandler ::- R.Application ->- IO ()+videoSizeSelectionHandler :: R.Application -> IO () videoSizeSelectionHandler R.Application { R.guiObjects = guiObjects@R.GuiObjects {
src/Window.hs view
@@ -133,7 +133,7 @@ } = do isWindowFullScreen <- readIORef isWindowFullScreenRef- when (not isWindowFullScreen) $ do+ unless isWindowFullScreen $ do videoInfoGathered <- readIORef videoInfoRef (width, _) <- GI.Gtk.windowGetSize window maybeWindowSize <- calculateWindowSize guiObjects (fromIntegral width :: Int) videoInfoGathered@@ -188,6 +188,7 @@ , R.seekScale = seekScale , R.playPauseButton = playPauseButton , R.videoWidthSelectionComboBox = videoWidthSelectionComboBox+ , R.subtitleSelectionComboBox = subtitleSelectionComboBox , R.fullscreenButton = fullscreenButton , R.playImage = playImage , R.pauseImage = pauseImage@@ -201,6 +202,7 @@ GI.Gtk.widgetHide seekScale GI.Gtk.widgetHide playPauseButton GI.Gtk.widgetHide fullscreenButton+ GI.Gtk.widgetHide subtitleSelectionComboBox GI.Gtk.widgetShow fileChooserButton GI.Gtk.widgetShow bottomControlsGtkBox GI.Gtk.widgetShow videoWidthSelectionComboBox
+ src/c/gst-ffi.c view
@@ -0,0 +1,14 @@+/*+ Movie Monad+ (C) 2017 David lettier+ lettier.com+*/++#include <gst/gst.h>+#include "gst-ffi.h"++GstTagList* get_text_tag_list(GstElement* playbin, int streamId) {+ GstTagList* tags;+ g_signal_emit_by_name(G_OBJECT(playbin), "get-text-tags", streamId, &tags);+ return tags;+}
+ src/c/gst-ffi.h view
@@ -0,0 +1,9 @@+/*+ Movie Monad+ (C) 2017 David lettier+ lettier.com+*/++#include <gst/gst.h>++GstTagList* get_text_tag_list(GstElement*, int);
src/data/gui.glade view
@@ -302,6 +302,23 @@ </packing> </child> <child>+ <object class="GtkComboBoxText" id="subtitle-selection-combo-box">+ <property name="can_focus">False</property>+ <property name="tooltip_text" translatable="yes">Select the subtitle language</property>+ <property name="margin_left">5</property>+ <property name="margin_right">5</property>+ <property name="active_id">-1</property>+ <items>+ <item id="-1" translatable="yes">None</item>+ </items>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">3</property>+ </packing>+ </child>+ <child> <object class="GtkButton" id="fullscreen-button"> <property name="app_paintable">True</property> <property name="can_focus">False</property>@@ -316,7 +333,7 @@ <packing> <property name="expand">False</property> <property name="fill">True</property>- <property name="position">3</property>+ <property name="position">4</property> </packing> </child> <child>@@ -329,7 +346,7 @@ <packing> <property name="expand">False</property> <property name="fill">False</property>- <property name="position">4</property>+ <property name="position">5</property> </packing> </child> <child>@@ -349,7 +366,7 @@ <property name="expand">False</property> <property name="fill">False</property> <property name="pack_type">end</property>- <property name="position">5</property>+ <property name="position">6</property> </packing> </child> </object>@@ -391,7 +408,7 @@ <property name="transient_for">window</property> <property name="attached_to">window</property> <property name="program_name">Movie Monad</property>- <property name="version">0.0.3.0</property>+ <property name="version">0.0.4.0</property> <property name="copyright" translatable="yes">(C) 2017 David Lettier lettier.com</property> <property name="website">https://github.com/lettier/movie-monad</property>