diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/makefile b/makefile --- a/makefile +++ b/makefile @@ -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 diff --git a/movie-monad.cabal b/movie-monad.cabal --- a/movie-monad.cabal +++ b/movie-monad.cabal @@ -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 diff --git a/src/Constants.hs b/src/Constants.hs --- a/src/Constants.hs +++ b/src/Constants.hs @@ -17,4 +17,4 @@ invalidVideoWidgetName = "invalid-video-widget" keyboardShortcutSeekAdvanceBy :: Double -keyboardShortcutSeekAdvanceBy = 10.0 +keyboardShortcutSeekAdvanceBy = 1.0 diff --git a/src/Keyboard.hs b/src/Keyboard.hs --- a/src/Keyboard.hs +++ b/src/Keyboard.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/Playbin.hs b/src/Playbin.hs --- a/src/Playbin.hs +++ b/src/Playbin.hs @@ -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) diff --git a/src/Records.hs b/src/Records.hs --- a/src/Records.hs +++ b/src/Records.hs @@ -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 diff --git a/src/SubtitleSelector.hs b/src/SubtitleSelector.hs new file mode 100644 --- /dev/null +++ b/src/SubtitleSelector.hs @@ -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 diff --git a/src/Utils.hs b/src/Utils.hs --- a/src/Utils.hs +++ b/src/Utils.hs @@ -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 diff --git a/src/VideoSizeSelector.hs b/src/VideoSizeSelector.hs --- a/src/VideoSizeSelector.hs +++ b/src/VideoSizeSelector.hs @@ -28,9 +28,7 @@ (videoSizeSelectionHandler application) ) -videoSizeSelectionHandler :: - R.Application -> - IO () +videoSizeSelectionHandler :: R.Application -> IO () videoSizeSelectionHandler R.Application { R.guiObjects = guiObjects@R.GuiObjects { diff --git a/src/Window.hs b/src/Window.hs --- a/src/Window.hs +++ b/src/Window.hs @@ -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 diff --git a/src/c/gst-ffi.c b/src/c/gst-ffi.c new file mode 100644 --- /dev/null +++ b/src/c/gst-ffi.c @@ -0,0 +1,14 @@ +/* + Movie Monad + (C) 2017 David lettier + lettier.com +*/ + +#include +#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; +} diff --git a/src/c/gst-ffi.h b/src/c/gst-ffi.h new file mode 100644 --- /dev/null +++ b/src/c/gst-ffi.h @@ -0,0 +1,9 @@ +/* + Movie Monad + (C) 2017 David lettier + lettier.com +*/ + +#include + +GstTagList* get_text_tag_list(GstElement*, int); diff --git a/src/data/gui.glade b/src/data/gui.glade --- a/src/data/gui.glade +++ b/src/data/gui.glade @@ -302,6 +302,23 @@ + + False + Select the subtitle language + 5 + 5 + -1 + + None + + + + False + True + 3 + + + True False @@ -316,7 +333,7 @@ False True - 3 + 4 @@ -329,7 +346,7 @@ False False - 4 + 5 @@ -349,7 +366,7 @@ False False end - 5 + 6 @@ -391,7 +408,7 @@ window window Movie Monad - 0.0.3.0 + 0.0.4.0 (C) 2017 David Lettier lettier.com https://github.com/lettier/movie-monad