diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,38 @@ ## CHANGELOG +------------------------------------------------------------------------------- + +### 0.0.5.0 + +#### Added + +- Repeat mode +- Custom icons for new bottom controls +- Custom styling for new bottom controls +- Added a one second fade in animation for the bottom controls +- Added extra error checking around window width combo box selection +- Mac install script + +#### Changed + +- Tooltips +- Use a SVG icon instead of PNG +- Fixed video info being changed before selecting a video +- Use play and pause image widget names to determine state of the play pause button +- If the user sets the window to a custom size, select nothing in the window selection combo box +- Set timeout for hiding the bottom controls to seven seconds instead of five +- AppImage meta data +- AppImage install script +- Snap packaging +- AUR packaging + +#### Removed + +- + +------------------------------------------------------------------------------- + ### 0.0.4.0 #### Added diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,43 +1,47 @@ ![Movie Monad](https://i.imgur.com/gdsyIMv.png) -# Movie Monad - -A free and simple to use video player built with Haskell. - -## Screenshots +# Movie Monad? Another video player? Really? -### Linux +Yes really. -![GUI showing "Caminandes 3: LLamigos" from the Blender Foundation](https://i.imgur.com/aYf6XOB.png) +Movie Monad is a free and simple to use video player made with Haskell. +Originally it was a proof of concept to add video playback to +[Gifcurry](https://lettier.github.io/gifcurry/) (another great app—check it out). +Nowadays it's a lightweight yet mighty media player used all over the +[world](https://snapcraft.io/movie-monad#js-snap-map) +everyday. -![GUI showing "Sintel" from the Blender Foundation](https://i.imgur.com/UBNYbER.jpg) +Movie Monad is cross platform so you'll never have to compute without it. +You can play files on your computer or stream videos from the web. +Play, pause, seek, repeat, resize, expand, and turn it up—Movie Monad gets out of +the way so you can watch the videos you love. -### Mac +So put down your copy of mpv, VLC, or Elmedia and try out Movie Monad—it's FREE! -![GUI showing "Big Buck Bunny" from the Blender Foundation](https://i.imgur.com/Tgmk7SW.png) +## What does Movie Monad look like? -![GUI showing the About window as seen on the Mac](https://i.imgur.com/pTJLQdM.png) +![Movie Monad](https://i.imgur.com/0zjy4xz.gif) +![Movie Monad](https://i.imgur.com/0SvqTpp.gif) -## Features +## What can I do with Movie Monad? -* Local or Remote Video Playback - * `file://` - * `http://` - * `https://` -* Window Size Quick Select -* Responsive Window Resizing -* Fullscreen Mode -* Seek -* Play and Pause -* Volume -* Subtitles - * Disable - * List and Pick from the Available Languages -* Command-line Play +* You can play video files from your hard drive or stream videos from the web. + * To play web videos, click the file open button, paste the URL into the text box, and click open. + * Movie Monad can handle `file://`, `https://`, and `http://`. +* You can play and pause. +* You can seek/scrub through the video. +* You can put the video on repeat. +* You can turn subtitles off or on and pick your language. +* You can turn up, turn down, or mute the volume. +* You can expand the video to fullscreen. +* You can quickly resize the video to standard sizes. +* You can resize the video to a custom size by resizing the window. + * Movie Monad will responsively adjust the video size to fill the window. +* You can play videos from the command line. * `movie-monad ./path/to/video/file.mp4` * `movie-monad http://www.domain.tld/path/to/video/file.mp4` -## Keyboard Shortcuts +## What are the keyboard controls? * Mute/Unmute * `m` @@ -46,6 +50,8 @@ * `f` * Show Controls * `c` +* Toggle Repeat + * `r` * Volume Up * `ArrowUp` * `AudioRaiseVolume` @@ -60,152 +66,111 @@ * `Space` * `AudioPlay` -## Tested On - -### Linux - -* [Ubuntu 17.10](https://www.ubuntu.com/desktop) -* [Ubuntu 16.04](https://www.ubuntu.com/desktop) -* [Ubuntu 14.04](https://www.ubuntu.com/desktop) -* [Linux Mint 18.2](https://linuxmint.com/) -* [Deepin 15.4.1](https://www.deepin.org/en/dde/) -* [Manjaro 17.04](https://manjaro.org/) -* [Antergos 17.10](https://antergos.com/) -* [Fedora 27](https://getfedora.org/) -* [Solus 3](https://solus-project.com/2017/08/15/solus-3-released/) - -### Mac - -* [macOS Sierra 10.12.6](https://en.wikipedia.org/wiki/MacOS_Sierra) - -## Dependencies - -### Run - -* [GTK+ >= 3.10](https://www.gtk.org/download/index.php) -* [GStreamer >= 1.0](https://gstreamer.freedesktop.org/download/) - * [GStreamer Good Plug-ins](https://gstreamer.freedesktop.org/modules/gst-plugins-good.html) - * [GStreamer Bad Plug-ins >= 1.8](https://gstreamer.freedesktop.org/modules/gst-plugins-bad.html) - -### Build - -* [Haskell](https://www.haskell.org/platform/prior.html) - * GHC == 8.0.2 - -## Install & Run - -### Linux +## How do I get a copy of Movie Monad? -#### AppImage +Movie Monad works on Linux, Mac, and most likely Windows. +Make sure you have GStreamer and GTK+ installed on your machine. +To find the latest version of Movie Monad, head over to the +[releases page](https://github.com/lettier/movie-monad/releases). -##### Download & Run +### I use Linux. -```bash -# Install GTK+ >= 3.10 (https://www.gtk.org/download/index.php) -# Install GStreamer >= 1.0 (https://gstreamer.freedesktop.org/download/) -# Install GStreamer Good Plug-ins (https://gstreamer.freedesktop.org/modules/gst-plugins-good.html) -# 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.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 -``` +If you use Linux then the easiest way to grab a copy of Movie Monad is by downloading the +[AppImage](https://github.com/lettier/movie-monad/releases/download/0.0.5.0/movie-monad-0.0.5.0-x86_64.AppImage). +After you download the +[AppImage](https://github.com/lettier/movie-monad/releases/download/0.0.5.0/movie-monad-0.0.5.0-x86_64.AppImage), +right click on it, select permissions, and check the box near execute. +With that out of the way—you're all set—just double click on the AppImage +and Movie Monad will pop up. -##### Install +You can also download and install the +[AppImage](https://github.com/lettier/movie-monad/releases/download/0.0.5.0/movie-monad-0.0.5.0-x86_64.AppImage) +using the handy +[AppImage install script](https://raw.githubusercontent.com/lettier/movie-monad/master/packaging/linux/app-image/movie-monad-install-app-image-script.sh) +(right click the link and select "Save link as..."). +Download the script, right click on it, select permissions, check the box near execute, and double click on it. +You should now see Movie Monad listed alongside your other installed programs. -```bash -# Install GTK+ >= 3.10 (https://www.gtk.org/download/index.php) -# Install GStreamer >= 1.0 (https://gstreamer.freedesktop.org/download/) -# Install GStreamer Good Plug-ins (https://gstreamer.freedesktop.org/modules/gst-plugins-good.html) -# Install GStreamer Bad Plug-ins >= 1.8 (https://gstreamer.freedesktop.org/modules/gst-plugins-bad.html) -# Install Wget (https://www.gnu.org/software/wget/) -wget "https://raw.githubusercontent.com/lettier/movie-monad/master/scripts/sh/install-app-image.sh" -O "movie-monad-install-app-image.sh" -chmod +x "movie-monad-install-app-image.sh" -./movie-monad-install-app-image.sh -``` +#### I use Arch/Manjaro/Antergos/pacman. -#### [Arch/Manjaro/Antergos](https://aur.archlinux.org/packages/movie-monad/) +If you'd rather install Movie Monad via `pacman` then copy the following into your terminal. ```bash -cd -# Install Git (https://git-scm.com/downloads) +cd "$HOME/Downloads" sudo pacman -S git -# Install Movie Monad from the AUR (https://aur.archlinux.org/packages/movie-monad/) -mkdir -p movie-monad-tmp -cd movie-monad-tmp +mkdir -p build-movie-monad +cd build-movie-monad git clone https://aur.archlinux.org/movie-monad.git cd movie-monad makepkg -sic +cd "$HOME/Downloads" +rm -rf build-movie-monad cd -rm -rf movie-monad-tmp movie-monad ``` -### Mac +#### I use Ubuntu/Mint/Debian/Deepin/snap. -```bash -# Install Homebrew (https://brew.sh/#install) -cd ~/Downloads -brew update && brew upgrade -brew install git -git clone https://github.com/lettier/movie-monad.git -cd movie-monad -brew cask install haskell-platform -brew install pkg-config libffi libav libsvg librsvg libogg libvorbis openh264 theora \ - gobject-introspection cairo gdk-pixbuf gsettings-desktop-schemas gtk+3 gtk-mac-integration \ - gstreamer gst-libav gst-plugins-base gst-plugins-good -brew install --with-gtk+3 gst-plugins-bad -stack setup -stack install hsc2hs -stack install -export PATH=$PATH:"$HOME/.local/bin/" -movie-monad -``` +Movie Monad is available as a snap from [Snapcraft](https://snapcraft.io/). +If you don't already have `snap`, go ahead and install it using the command `sudo apt install snapd`. -### [Hackage](https://hackage.haskell.org/package/movie-monad) +You can install the +[Movie Monad snap](https://snapcraft.io/movie-monad) +right from your browser or via the command line. +For the command line route, paste the following into your terminal. ```bash -# Install GObject Introspection (https://wiki.gnome.org/action/show/Projects/GObjectIntrospection) -# Install GTK+ >= 3.10 (https://www.gtk.org/download/index.php) -# Install GStreamer >= 1.0 (https://gstreamer.freedesktop.org/download/) -# Install GStreamer Good Plug-ins (https://gstreamer.freedesktop.org/modules/gst-plugins-good.html) -# Install GStreamer Bad Plug-ins >= 1.8 (https://gstreamer.freedesktop.org/modules/gst-plugins-bad.html) -# Install Cabal, GHC == 8.0.2 (https://www.haskell.org/platform/prior.html) -# Install Cabal Install (https://www.haskell.org/platform/prior.html) -cabal install movie-monad +snap install movie-monad +sudo snap connect movie-monad:mount-observe +sudo snap connect movie-monad:removable-media +sudo snap connect movie-monad:raw-usb movie-monad ``` -### [GitHub](https://github.com/lettier/movie-monad) +### I use Mac. +Mac users can download and run the +[Mac install script](https://raw.githubusercontent.com/lettier/movie-monad/master/packaging/mac/movie-monad-mac-install-script.command) +(hold down control, click the link, and select "Save Link As..."). +After running the install script, a shortcut to Movie Monad will be on your desktop. + +### I'm a Haskell developer. + +If you develop Haskell programs then the easiest way to build Movie Monad is with +[Haskell Stack](https://docs.haskellstack.org/en/stable/README/). +Copy the following into your terminal. + ```bash -# Install GObject Introspection (https://wiki.gnome.org/action/show/Projects/GObjectIntrospection) -# Install GTK+ >= 3.10 (https://www.gtk.org/download/index.php) -# Install GStreamer >= 1.0 (https://gstreamer.freedesktop.org/download/) -# Install GStreamer Good Plug-ins (https://gstreamer.freedesktop.org/modules/gst-plugins-good.html) -# Install GStreamer Bad Plug-ins >= 1.8 (https://gstreamer.freedesktop.org/modules/gst-plugins-bad.html) -# Install Git (https://git-scm.com/downloads) -# Install GNU Make (https://www.gnu.org/software/make/) -# Install Haskell, GHC == 8.0.2 (https://www.haskell.org/platform/prior.html) -# Install Haksell Stack (https://www.haskell.org/platform/) +cd "$HOME/Downloads" git clone https://github.com/lettier/movie-monad.git -cd movie-monad/ -make -make install -make run +cd movie-monad +stack update +stack setup +stack install alex happy +stack install haskell-gi +stack install +stack exec -- movie-monad ``` -## Developer Documentation +## What dependencies does Movie Monad use? -[Let's make a GTK Video Player with Haskell](https://lettier.github.io/posts/2017-08-30-haskell-gtk-video-player.html) +### To run Movie Monad. -## License +* [GTK+ >= 3.10](https://www.gtk.org/download/index.php) +* [GStreamer >= 1.0](https://gstreamer.freedesktop.org/download/) + * [GStreamer Good Plug-ins](https://gstreamer.freedesktop.org/modules/gst-plugins-good.html) + * [GStreamer Bad Plug-ins >= 1.8](https://gstreamer.freedesktop.org/modules/gst-plugins-bad.html) +### To build Movie Monad. + +* [GObject Introspection](https://wiki.gnome.org/action/show/Projects/GObjectIntrospection) +* [Haskell Stack](https://docs.haskellstack.org/en/stable/README/) + +## What is the license? + See [LICENSE](LICENSE). -## Copyright +## Who wrote Movie Monad? (C) 2017 David Lettier [lettier.com](http://www.lettier.com/) diff --git a/makefile b/makefile --- a/makefile +++ b/makefile @@ -3,50 +3,63 @@ .RECIPEPREFIX != ps -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):$(STACK_SNAPSHOT_INSTALL_ROOT_BIN) -CABAL=env PATH=$(PATH):$(STACK_PATHS) $(STACK_SNAPSHOT_INSTALL_ROOT_BIN)/cabal +_NAME="movie-monad" +_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):$(_STACK_SNAPSHOT_INSTALL_ROOT_BIN) +_CABAL=env PATH=$(PATH):$(_STACK_PATHS) "$(_STACK_SNAPSHOT_INSTALL_ROOT_BIN)/cabal" +_CABAL_SANDBOX_DIR=".cabal-sandbox" +_APPLICATIONS_DESKTOP_DIR="$(_CABAL_SANDBOX_DIR)/share/applications" +_ICONS_HICOLOR_SCALABLE_APPS_DIR="$(_CABAL_SANDBOX_DIR)/share/icons/hicolor/scalable/apps" +_PACKAGING_LINUX_COMMON_DIR="./packaging/linux/common" -export PATH := $(PATH):$(STACK_PATHS) +export PATH := $(PATH):$(_STACK_PATHS) -all: setup build +all: install setup: - $(STACK) setup && \ - $(STACK) update && \ - $(STACK) build alex && \ - $(STACK) build happy + $(_STACK) update && \ + $(_STACK) setup && \ + $(_STACK) install alex happy && \ + $(_STACK) install haskell-gi -build: setup - $(STACK) build +cabal_update: setup + $(_CABAL) update -install: build - $(STACK) install +cabal_sandbox_init: cabal_update + $(_CABAL) sandbox init -run: install - $(STACK) exec -- movie-monad +cabal_clean: cabal_update + $(_CABAL) clean && \ + $(_CABAL) sandbox init && \ + $(_CABAL) sandbox delete && \ + $(_CABAL) sandbox init -build_sdist: - $(STACK) sdist +cabal_install_dependencies: cabal_sandbox_init + $(_CABAL) --require-sandbox install --dependencies-only --force-reinstalls -j -w $(_STACK_GHC_EXE) -cabal_update: setup - $(STACK) build cabal-install && \ - $(CABAL) update +cabal_configure: cabal_install_dependencies + $(_CABAL) --require-sandbox configure --enable-relocatable -w $(_STACK_GHC_EXE) -cabal_clean: cabal_update - $(CABAL) clean && \ - $(CABAL) sandbox init && \ - $(CABAL) sandbox delete && \ - $(CABAL) sandbox init +cabal_build: cabal_configure + $(_CABAL) --require-sandbox build -j -cabal_install_relocatable_executable: cabal_clean - $(CABAL) sandbox init && \ - $(CABAL) --require-sandbox install --dependencies-only --force-reinstalls -j -w $(STACK_GHC_EXE) && \ - $(CABAL) --require-sandbox configure --enable-relocatable -w $(STACK_GHC_EXE) && \ - $(CABAL) --require-sandbox build -j && \ - $(CABAL) --require-sandbox install --enable-relocatable --force-reinstalls -j -w $(STACK_GHC_EXE) +cabal_install: cabal_build + $(_CABAL) --require-sandbox install --enable-relocatable --force-reinstalls -j -w $(_STACK_GHC_EXE) + +applications_desktop: + mkdir -p $(_APPLICATIONS_DESKTOP_DIR) && \ + cp $(_PACKAGING_LINUX_COMMON_DIR)/$(_NAME).desktop $(_APPLICATIONS_DESKTOP_DIR)/ + +icons_hicolor_scalable_apps: + mkdir -p $(_ICONS_HICOLOR_SCALABLE_APPS_DIR) && \ + cp $(_PACKAGING_LINUX_COMMON_DIR)/$(_NAME)-icon.svg $(_ICONS_HICOLOR_SCALABLE_APPS_DIR)/ + +install: cabal_install applications_desktop icons_hicolor_scalable_apps + +build_sdist: + $(_STACK) sdist diff --git a/movie-monad.cabal b/movie-monad.cabal --- a/movie-monad.cabal +++ b/movie-monad.cabal @@ -1,13 +1,13 @@ name: movie-monad -version: 0.0.4.0 +version: 0.0.5.0 synopsis: Plays videos using GStreamer and GTK+. -description: A free and simple to use video player built with Haskell. +description: A free and simple to use video player made with Haskell. homepage: https://github.com/lettier/movie-monad license: BSD3 license-file: LICENSE author: Lettier maintainer: Lettier -copyright: 2017 David Lettier +copyright: (C) 2017 David Lettier category: Application , Multimedia , Multimedia Player @@ -21,10 +21,19 @@ , stack.yaml , ./src/dev/Paths_movie_monad.hs , ./src/data/gui.glade + , ./src/data/style.css + , ./src/data/style-3-18.css + , ./src/data/style-3-20.css , ./src/data/movie-monad-logo.svg - , ./src/data/movie-monad-icon.png + , ./src/data/movie-monad-icon.svg + , ./src/data/about-icon.svg + , ./src/data/play-icon.svg + , ./src/data/pause-icon.svg + , ./src/data/repeat-icon.svg + , ./src/data/fullscreen-icon.svg , ./src/Records.hs , ./src/Constants.hs + , ./src/Reset.hs , ./src/Window.hs , ./src/CommandLine.hs , ./src/Keyboard.hs @@ -40,13 +49,22 @@ , ./src/VideoInfo.hs , ./src/Playbin.hs , ./src/Uri.hs + , ./src/CssStyle.hs , ./src/Utils.hs , ./src/ScreensaverAndPowerManagement.hs , ./src/c/gst-ffi.h , ./src/c/gst-ffi.c data-files: data/gui.glade + , data/style.css + , data/style-3-18.css + , data/style-3-20.css , data/movie-monad-logo.svg - , data/movie-monad-icon.png + , data/movie-monad-icon.svg + , data/about-icon.svg + , data/play-icon.svg + , data/pause-icon.svg + , data/repeat-icon.svg + , data/fullscreen-icon.svg data-dir: ./src/ source-repository head @@ -54,8 +72,8 @@ location: https://github.com/lettier/movie-monad.git executable movie-monad - main-is: Main.hs - default-language: Haskell2010 + main-is: Main.hs + default-language: Haskell2010 build-depends: base == 4.9.* , filepath == 1.4.* , system-fileio == 0.3.* @@ -65,18 +83,21 @@ , process == 1.4.* , MissingH == 1.4.* , network-uri == 2.6.* - , haskell-gi == 0.20.* - , haskell-gi-base == 0.20.8 + , bytestring == 0.10.* + , haskell-gi == 0.21.* + , haskell-gi-base == 0.21.* + , haskell-gi-overloading == 1.0 , gi-gobject == 2.0.* , gi-glib == 2.0.* , gi-gdk == 3.0.* , gi-gdkpixbuf == 2.0.* , gi-gst == 1.0.* , gi-gstvideo == 1.0.* - , gi-gtk == 3.0.18 + , gi-gtk == 3.0.* other-modules: Paths_movie_monad , Records , Constants + , Reset , Window , CommandLine , Keyboard @@ -92,9 +113,10 @@ , VideoInfo , Uri , Playbin + , CssStyle , Utils , ScreensaverAndPowerManagement - hs-source-dirs: ./src/ - includes: ./src/c/gst-ffi.h - c-sources: ./src/c/gst-ffi.c + 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/About.hs b/src/About.hs --- a/src/About.hs +++ b/src/About.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -14,26 +14,21 @@ addAboutHandler :: R.Application -> IO () addAboutHandler - R.Application { - R.guiObjects = R.GuiObjects { - R.aboutButton = aboutButton - , R.aboutDialog = aboutDialog + R.Application + { R.guiObjects = + R.GuiObjects + { R.aboutButton = aboutButton + , R.aboutDialog = aboutDialog } } = - void ( - GI.Gtk.onWidgetButtonReleaseEvent aboutButton (aboutButtonReleaseHandler aboutDialog) - ) + void $ + GI.Gtk.onWidgetButtonReleaseEvent + aboutButton + (aboutButtonReleaseHandler aboutDialog) -aboutButtonReleaseHandler :: - GI.Gtk.AboutDialog -> - GI.Gdk.EventButton -> - IO Bool -aboutButtonReleaseHandler aboutDialog _ = - void ( - GI.Gtk.onDialogResponse aboutDialog (\ _ -> GI.Gtk.widgetHide aboutDialog) - ) >> - void ( - GI.Gtk.dialogRun aboutDialog - ) >> +aboutButtonReleaseHandler :: GI.Gtk.AboutDialog -> GI.Gdk.EventButton -> IO Bool +aboutButtonReleaseHandler aboutDialog _ = do + _ <- GI.Gtk.onDialogResponse aboutDialog (\ _ -> GI.Gtk.widgetHide aboutDialog) + _ <- GI.Gtk.dialogRun aboutDialog return True diff --git a/src/CommandLine.hs b/src/CommandLine.hs --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} diff --git a/src/Constants.hs b/src/Constants.hs --- a/src/Constants.hs +++ b/src/Constants.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -11,10 +11,13 @@ import Data.Text hideOnScreenControlsInterval :: Integral a => a -hideOnScreenControlsInterval = 5 +hideOnScreenControlsInterval = 7 invalidVideoWidgetName :: Data.Text.Text invalidVideoWidgetName = "invalid-video-widget" keyboardShortcutSeekAdvanceBy :: Double keyboardShortcutSeekAdvanceBy = 1.0 + +windowMinimumSize :: Integral a => a +windowMinimumSize = 448 diff --git a/src/CssStyle.hs b/src/CssStyle.hs new file mode 100644 --- /dev/null +++ b/src/CssStyle.hs @@ -0,0 +1,121 @@ +{- + Movie Monad + (C) 2017 David Lettier + lettier.com +-} + +{-# LANGUAGE OverloadedStrings #-} + +module CssStyle where + +import Prelude +import Control.Monad +import Data.Word +import Data.Text +import qualified Data.ByteString +import qualified GI.Gdk +import qualified GI.Gtk + +import qualified Records as R + +import Paths_movie_monad + +cssPriority :: Word32 +cssPriority = + fromIntegral GI.Gtk.STYLE_PROVIDER_PRIORITY_APPLICATION :: Word32 + +applyCss :: R.GuiObjects -> IO () +applyCss + guiObjects + = do + maybeScreen <- GI.Gdk.screenGetDefault + provider <- GI.Gtk.cssProviderNew + styleFile <- getDataFileName "data/style.css" + styleFile318 <- getDataFileName "data/style-3-18.css" + styleFile320 <- getDataFileName "data/style-3-20.css" + isGtkVersionGte310 <- isGtkVersionGte 3 10 + isGtkVersionGte318 <- isGtkVersionGte 3 18 + isGtkVersionGte320 <- isGtkVersionGte 3 20 + case ( maybeScreen + , isGtkVersionGte310 + , isGtkVersionGte318 + , isGtkVersionGte320 + ) + of + (Just screen, True, False, False) -> do + GI.Gtk.cssProviderLoadFromPath provider (Data.Text.pack styleFile) + GI.Gtk.styleContextAddProviderForScreen + screen + provider + cssPriority + setScaleSizeForLegacyGtk guiObjects + (Just screen, True, True, False) -> do + styleFileContents <- Data.ByteString.readFile styleFile + styleFileContents318 <- Data.ByteString.readFile styleFile318 + let totalStyleFileContents = + Data.ByteString.concat + [styleFileContents, styleFileContents318] + GI.Gtk.cssProviderLoadFromData provider totalStyleFileContents + GI.Gtk.styleContextAddProviderForScreen + screen + provider + cssPriority + setScaleSizeForLegacyGtk guiObjects + (Just screen, True, True, True) -> do + styleFileContents <- Data.ByteString.readFile styleFile + styleFileContents318 <- Data.ByteString.readFile styleFile318 + styleFileContents320 <- Data.ByteString.readFile styleFile320 + let totalStyleFileContents = + Data.ByteString.concat + [styleFileContents, styleFileContents318, styleFileContents320] + GI.Gtk.cssProviderLoadFromData provider totalStyleFileContents + GI.Gtk.styleContextAddProviderForScreen + screen + provider + cssPriority + _ -> return () + +setScaleSizeForLegacyGtk :: R.GuiObjects -> IO () +setScaleSizeForLegacyGtk + R.GuiObjects + { R.window = window + , R.seekScale = seekScale + } + = do + GI.Gtk.containerForall + window + (\ windowChild -> do + windowChildName <- GI.Gtk.widgetGetName windowChild + when (windowChildName == "GtkPopover") $ do + maybePopover <- GI.Gtk.castTo GI.Gtk.Popover windowChild + case maybePopover of + Just popover -> + GI.Gtk.containerForall + popover + (\ popoverChild -> do + popoverChildName <- GI.Gtk.widgetGetName popoverChild + when (popoverChildName == "GtkBox") $ do + maybeBox <- GI.Gtk.castTo GI.Gtk.Box popoverChild + case maybeBox of + Just box -> + GI.Gtk.containerForall + box + (\ boxChild -> do + boxChildName <- GI.Gtk.widgetGetName boxChild + when (boxChildName == "GtkScale") $ do + maybeScale <- GI.Gtk.castTo GI.Gtk.Scale boxChild + case maybeScale of + Just scale -> GI.Gtk.rangeSetMinSliderSize scale 15 + _ -> return () + ) + _ -> return () + ) + _ -> return () + ) + GI.Gtk.rangeSetMinSliderSize seekScale 15 + +isGtkVersionGte :: Word32 -> Word32 -> IO Bool +isGtkVersionGte major minor = do + major' <- GI.Gtk.getMajorVersion + minor' <- GI.Gtk.getMinorVersion + return (major' >= major && minor' >= minor) diff --git a/src/ErrorMessage.hs b/src/ErrorMessage.hs --- a/src/ErrorMessage.hs +++ b/src/ErrorMessage.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} diff --git a/src/FileChooser.hs b/src/FileChooser.hs --- a/src/FileChooser.hs +++ b/src/FileChooser.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -9,6 +9,7 @@ module FileChooser where import Control.Monad +import Data.Maybe import Data.Int import Data.Text import Data.IORef @@ -19,8 +20,8 @@ import qualified Records as R import Constants +import Reset import Window -import PlayPause import ErrorMessage import VideoInfo import Playbin @@ -29,125 +30,108 @@ addFileChooserHandlers :: R.Application -> IO () addFileChooserHandlers - application@R.Application { - R.guiObjects = R.GuiObjects { - R.fileChooserButton = fileChooserButton - , R.fileChooserDialog = fileChooserDialog - , R.fileChooserWidget = fileChooserWidget - , R.fileChooserEntry = fileChooserEntry + application@R.Application + { R.guiObjects = + R.GuiObjects + { R.fileChooserButton = fileChooserButton + , R.fileChooserDialog = fileChooserDialog + , R.fileChooserWidget = fileChooserWidget + , R.fileChooserEntry = fileChooserEntry } } - = - void (GI.Gtk.onWidgetButtonReleaseEvent fileChooserButton (fileChooserButtonClickHandler application)) >> - void (GI.Gtk.onDialogResponse fileChooserDialog (fileChooserDialogResponseHandler application)) >> - void (GI.Gtk.onFileChooserSelectionChanged fileChooserWidget (fileChooserSelectionChangedHandler application)) >> - void (GI.Gtk.onEntryIconRelease fileChooserEntry (\ _ _ -> GI.Gtk.entrySetText fileChooserEntry "")) + = do + void $ + GI.Gtk.onWidgetButtonReleaseEvent fileChooserButton (fileChooserButtonClickHandler application) + void $ + GI.Gtk.onDialogResponse fileChooserDialog (fileChooserDialogResponseHandler application) + void $ + GI.Gtk.onFileChooserSelectionChanged fileChooserWidget (fileChooserSelectionChangedHandler application) + void $ + GI.Gtk.onEntryIconRelease fileChooserEntry (\ _ _ -> GI.Gtk.entrySetText fileChooserEntry "") -fileChooserDialogResponseHandler :: - R.Application -> - Int32 -> - IO () +fileChooserDialogResponseHandler :: R.Application -> Int32 -> IO () fileChooserDialogResponseHandler - R.Application { - R.guiObjects = guiObjects@R.GuiObjects { - R.videoWidget = videoWidget - , R.seekScale = seekScale - , R.playPauseButton = playPauseButton - , R.videoWidthSelectionComboBox = videoWidthSelectionComboBox - , R.fullscreenButton = fullscreenButton - , R.fileChooserEntry = fileChooserEntry - , R.fileChooserButtonLabel = fileChooserButtonLabel - , R.volumeButton = volumeButton - , R.errorMessageDialog = errorMessageDialog - , R.fileChooserDialog = fileChooserDialog - , R.playImage = playImage - , R.pauseImage = pauseImage + application@R.Application + { R.guiObjects = + guiObjects@R.GuiObjects + { R.window = window + , R.videoWidget = videoWidget + , R.windowWidthSelectionComboBoxText = windowWidthSelectionComboBoxText + , R.fileChooserEntry = fileChooserEntry + , R.fileChooserButtonLabel = fileChooserButtonLabel + , R.volumeButton = volumeButton + , R.errorMessageDialog = errorMessageDialog + , R.fileChooserDialog = fileChooserDialog } - , R.ioRefs = R.IORefs { - R.isWindowFullScreenRef = isWindowFullScreenRef - , R.videoInfoRef = videoInfoRef - , R.previousFileNamePathRef = previousFileNamePathRef + , R.ioRefs = + R.IORefs + { R.isWindowFullScreenRef = isWindowFullScreenRef + , R.videoInfoRef = videoInfoRef + , R.previousFileNamePathRef = previousFileNamePathRef } - , R.playbin = playbin + , R.playbin = playbin } responseId = do GI.Gtk.widgetHide fileChooserDialog - handleResponseType GI.Gtk.ResponseTypeOk - where - handleResponseType :: (Enum a, Ord a) => a -> IO () - handleResponseType enum - | enumToInt32 enum == responseId = do - _ <- GI.Gst.elementSetState playbin GI.Gst.StateNull - filePathName <- GI.Gtk.entryGetText fileChooserEntry - let filePathNameStr = Data.Text.unpack filePathName - (_, fileNameEmpty) <- setFileChooserButtonLabel fileChooserButtonLabel filePathName - isWindowFullScreen <- readIORef isWindowFullScreenRef - videoWidthSelection <- getSelectedVideoWidth videoWidthSelectionComboBox - setPlaybinUriAndVolume playbin filePathNameStr volumeButton - handleFileName - fileNameEmpty - filePathNameStr - isWindowFullScreen - videoWidthSelection - | otherwise = do - filePathName <- readIORef previousFileNamePathRef - _ <- setFileChooserButtonLabel fileChooserButtonLabel filePathName - GI.Gtk.entrySetText fileChooserEntry filePathName - handleFileName :: - Bool -> - Prelude.String -> - Bool -> - Int -> - IO () - handleFileName True _ _ _ = atomicWriteIORef videoInfoRef R.defaultVideoInfo >> resetWindow guiObjects - handleFileName - _ - filePathNameStr - isWindowFullScreen - videoWidthSelection - = do - retrievedVideoInfo <- getVideoInfo videoInfoRef filePathNameStr - maybeWindowSize <- calculateWindowSize guiObjects videoWidthSelection retrievedVideoInfo - GI.Gtk.widgetSetSensitive seekScale True - if R.isSeekable retrievedVideoInfo - then GI.Gtk.widgetShow seekScale - else GI.Gtk.widgetHide seekScale - case maybeWindowSize of - Nothing -> do - resetWindow guiObjects - runErrorMessageDialog - errorMessageDialog - (Data.Text.pack $ Prelude.concat ["\"", filePathNameStr, "\" is not a video."]) - Just (width, height) -> do - videoWidgetName <- GI.Gtk.widgetGetName videoWidget - if videoWidgetName == invalidVideoWidgetName - then do - resetWindow guiObjects + if enumToInt32 GI.Gtk.ResponseTypeOk == responseId + then do + filePathName <- GI.Gtk.entryGetText fileChooserEntry + maybeFileName <- setFileChooserButtonLabel fileChooserButtonLabel filePathName + case maybeFileName of + (Just _) -> do + let filePathNameStr = Data.Text.unpack filePathName + videoInfo <- fromMaybe R.defaultVideoInfo <$> getVideoInfo videoInfoRef filePathNameStr + desiredWindowWidth <- getDesiredWindowWidth windowWidthSelectionComboBoxText window + maybeWindowSize <- calculateWindowSize guiObjects desiredWindowWidth videoInfo + case maybeWindowSize of + Just (width, height) -> do + videoWidgetName <- GI.Gtk.widgetGetName videoWidget + if videoWidgetName == invalidVideoWidgetName + then do + resetApplication application + runErrorMessageDialog + errorMessageDialog + "Cannot play the video. Please install the bad plugins, version 1.8 or higher, for GStreamer version 1." + else do + isWindowFullScreen <- readIORef isWindowFullScreenRef + setupWindowForPlayback + guiObjects + (R.isSeekable videoInfo) + isWindowFullScreen + width + height + saveVideoInfo videoInfoRef videoInfo + resetPlaybin playbin + setPlaybinUriAndVolume playbin filePathNameStr volumeButton + void $ GI.Gst.elementSetState playbin GI.Gst.StatePlaying + _ -> do + resetApplication application runErrorMessageDialog - errorMessageDialog - "Cannot play the video. Please install the bad plugins, version 1.8 or higher, for GStreamer version 1." - else do - GI.Gtk.widgetShow videoWidget - GI.Gtk.widgetShow playPauseButton - GI.Gtk.widgetShow fullscreenButton - setPlayPauseButton playPauseButton playImage pauseImage True - unless isWindowFullScreen $ - setWindowSize guiObjects width height - void $ GI.Gst.elementSetState playbin GI.Gst.StatePlaying + errorMessageDialog $ + Data.Text.pack $ + Prelude.concat ["\"", filePathNameStr, "\" is not a video."] + _ -> + resetApplication application + else do + filePathName <- readIORef previousFileNamePathRef + fromMaybe R.defaultVideoInfo <$> + getVideoInfo videoInfoRef (Data.Text.unpack filePathName) >>= + saveVideoInfo videoInfoRef + _ <- setFileChooserButtonLabel fileChooserButtonLabel filePathName + GI.Gtk.entrySetText fileChooserEntry filePathName -fileChooserButtonClickHandler :: - R.Application -> - GI.Gdk.EventButton -> - IO Bool +fileChooserButtonClickHandler :: R.Application -> GI.Gdk.EventButton -> IO Bool fileChooserButtonClickHandler - R.Application { - R.guiObjects = R.GuiObjects { - R.fileChooserEntry = fileChooserEntry - , R.fileChooserDialog = fileChooserDialog + R.Application + { R.guiObjects = + R.GuiObjects + { R.fileChooserEntry = fileChooserEntry + , R.fileChooserDialog = fileChooserDialog } - , R.ioRefs = R.IORefs { - R.previousFileNamePathRef = previousFileNamePathRef + , R.ioRefs = + R.IORefs + { R.previousFileNamePathRef = previousFileNamePathRef } } _ @@ -157,17 +141,17 @@ _ <- GI.Gtk.dialogRun fileChooserDialog return True -fileChooserSelectionChangedHandler :: - R.Application -> - IO () +fileChooserSelectionChangedHandler :: R.Application -> IO () fileChooserSelectionChangedHandler - R.Application { - R.guiObjects = R.GuiObjects { - R.fileChooserWidget = fileChooserWidget - , R.fileChooserEntry = fileChooserEntry + R.Application + { R.guiObjects = + R.GuiObjects + { R.fileChooserWidget = fileChooserWidget + , R.fileChooserEntry = fileChooserEntry } - , R.ioRefs = R.IORefs { - R.videoInfoRef = videoInfoRef + , R.ioRefs = + R.IORefs + { R.videoInfoRef = videoInfoRef } } = do @@ -177,12 +161,17 @@ Just uri' -> do let uri = Network.URI.unEscapeString $ Data.Text.unpack uri' local <- isLocalFile uri - video <- R.isVideo <$> getVideoInfo videoInfoRef uri + video <- R.isVideo . fromMaybe R.defaultVideoInfo <$> getVideoInfo videoInfoRef uri GI.Gtk.entrySetText fileChooserEntry (if local && video then Data.Text.pack uri else "") -setFileChooserButtonLabel :: GI.Gtk.Label -> Data.Text.Text -> IO (Data.Text.Text, Bool) +setFileChooserButtonLabel :: GI.Gtk.Label -> Data.Text.Text -> IO (Maybe Data.Text.Text) setFileChooserButtonLabel fileChooserButtonLabel filePathName = do let fileName = fileNameFromFilePathName filePathName let fileNameEmpty = isTextEmpty fileName - GI.Gtk.labelSetText fileChooserButtonLabel (if fileNameEmpty then "Open" else fileName) - return (fileName, fileNameEmpty) + if fileNameEmpty + then do + GI.Gtk.labelSetText fileChooserButtonLabel "Open" + return Nothing + else do + GI.Gtk.labelSetText fileChooserButtonLabel fileName + return $ Just fileName diff --git a/src/Fullscreen.hs b/src/Fullscreen.hs --- a/src/Fullscreen.hs +++ b/src/Fullscreen.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -31,8 +31,8 @@ R.Application { R.guiObjects = R.GuiObjects { R.window = window - , R.fileChooserButton = fileChooserButton - , R.videoWidthSelectionComboBox = videoWidthSelectionComboBox + , R.fileChooserButton = fileChooserButton + , R.windowWidthSelectionComboBoxText = windowWidthSelectionComboBoxText } , R.ioRefs = R.IORefs { R.isWindowFullScreenRef = isWindowFullScreenRef @@ -43,11 +43,11 @@ isWindowFullScreen <- readIORef isWindowFullScreenRef if isWindowFullScreen then do - GI.Gtk.widgetShow videoWidthSelectionComboBox + GI.Gtk.widgetShow windowWidthSelectionComboBoxText GI.Gtk.widgetShow fileChooserButton void $ GI.Gtk.windowUnfullscreen window else do - GI.Gtk.widgetHide videoWidthSelectionComboBox + GI.Gtk.widgetHide windowWidthSelectionComboBoxText GI.Gtk.widgetHide fileChooserButton void $ GI.Gtk.windowFullscreen window return True diff --git a/src/Keyboard.hs b/src/Keyboard.hs --- a/src/Keyboard.hs +++ b/src/Keyboard.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -21,37 +21,38 @@ addKeyboardEventHandler :: R.Application -> IO () addKeyboardEventHandler - application@R.Application { - R.guiObjects = R.GuiObjects { - R.window = window - } + application@R.Application + { R.guiObjects = + R.GuiObjects + { R.window = window + } } = void $ GI.Gtk.onWidgetKeyPressEvent window $ keyboardEventHandler application -keyboardEventHandler :: - R.Application -> - GI.Gdk.EventKey -> - IO Bool +keyboardEventHandler :: R.Application -> GI.Gdk.EventKey -> IO Bool keyboardEventHandler - application@R.Application { - R.guiObjects = R.GuiObjects { - R.volumeButton = volumeButton - , R.seekScale = seekScale + application@R.Application + { R.guiObjects = + R.GuiObjects + { R.volumeButton = volumeButton + , R.seekScale = seekScale + , R.repeatCheckButton = repeatCheckButton } - , R.ioRefs = R.IORefs { - R.videoInfoRef = videoInfoRef - } + , R.ioRefs = + R.IORefs + { R.videoInfoRef = videoInfoRef + } } eventKey = do - videoInfoGathered <- readIORef videoInfoRef - let isVideo = R.isVideo videoInfoGathered - let volumeDelta = 0.05 - oldVolume <- GI.Gtk.scaleButtonGetValue volumeButton - keyValue <- GI.Gdk.getEventKeyKeyval eventKey + videoInfo <- readIORef videoInfoRef + oldVolume <- GI.Gtk.scaleButtonGetValue volumeButton + keyValue <- GI.Gdk.getEventKeyKeyval eventKey eventButton <- GI.Gdk.newZeroEventButton - rangeValue <- GI.Gtk.rangeGetValue seekScale + rangeValue <- GI.Gtk.rangeGetValue seekScale + let isVideo = R.isVideo videoInfo + let volumeDelta = 0.05 -- Mute Toggle when (keyValue == GI.Gdk.KEY_m || keyValue == GI.Gdk.KEY_AudioMute) $ do let newVolume = if oldVolume <= 0.0 then 0.5 else 0.0 @@ -59,6 +60,10 @@ -- Play/Pause Toggle when ((keyValue == GI.Gdk.KEY_space || keyValue == GI.Gdk.KEY_AudioPlay) && isVideo) $ void $ playPauseButtonClickHandler application eventButton + -- Fullscreen Toggle + when (keyValue == GI.Gdk.KEY_r && isVideo) $ do + repeatVideo <- GI.Gtk.toggleButtonGetActive repeatCheckButton + void $ GI.Gtk.toggleButtonSetActive repeatCheckButton (not repeatVideo) -- Volume Up when (keyValue == GI.Gdk.KEY_Up || keyValue == GI.Gdk.KEY_AudioRaiseVolume) $ do let newVolume = if oldVolume >= 1.0 then 1.0 else oldVolume + volumeDelta @@ -68,12 +73,12 @@ 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) $ + when (keyValue == GI.Gdk.KEY_Left && isVideo) $ void $ GI.Gtk.rangeSetValue seekScale (clamp 0.0 100.0 (rangeValue - keyboardShortcutSeekAdvanceBy)) -- Seek right - when (keyValue == GI.Gdk.KEY_Right) $ + when (keyValue == GI.Gdk.KEY_Right && isVideo) $ void $ GI.Gtk.rangeSetValue seekScale (clamp 0.0 100.0 (rangeValue + keyboardShortcutSeekAdvanceBy)) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,11 +1,13 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE + OverloadedStrings + , ScopedTypeVariables +#-} module Main where @@ -24,6 +26,7 @@ import qualified Records as R import Constants +import Reset import Window import CommandLine import Mouse @@ -38,6 +41,7 @@ import SubtitleSelector import Playbin import ScreensaverAndPowerManagement (disable, enable) +import CssStyle import Utils import Paths_movie_monad @@ -54,30 +58,31 @@ _ <- GI.Gtk.init Nothing gladeFile <- getDataFileName "data/gui.glade" - builder <- GI.Gtk.builderNewFromFile (pack gladeFile) + builder <- GI.Gtk.builderNewFromFile (pack gladeFile) - window <- builderGetObject GI.Gtk.Window builder "window" - fileChooserButton <- builderGetObject GI.Gtk.Button builder "file-chooser-button" - fileChooserButtonLabel <- builderGetObject GI.Gtk.Label builder "file-chooser-button-label" - fileChooserDialog <- builderGetObject GI.Gtk.Dialog builder "file-chooser-dialog" - fileChooserEntry <- builderGetObject GI.Gtk.Entry builder "file-chooser-entry" - fileChooserWidget <- builderGetObject GI.Gtk.FileChooserWidget builder "file-chooser-widget" - fileChooserCancelButton <- builderGetObject GI.Gtk.Button builder "file-chooser-cancel-button" - fileChooserOpenButton <- builderGetObject GI.Gtk.Button builder "file-chooser-open-button" - videoWidgetBox <- builderGetObject GI.Gtk.Box builder "video-widget-box" - bottomControlsGtkBox <- builderGetObject GI.Gtk.Box builder "bottom-controls-gtk-box" - seekScale <- builderGetObject GI.Gtk.Scale builder "seek-scale" - playPauseButton <- builderGetObject GI.Gtk.Button builder "play-pause-button" - playImage <- builderGetObject GI.Gtk.Image builder "play-image" - 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" - aboutButton <- builderGetObject GI.Gtk.Button builder "about-button" - aboutDialog <- builderGetObject GI.Gtk.AboutDialog builder "about-dialog" + window <- builderGetObject GI.Gtk.Window builder "window" + fileChooserButtonLabel <- builderGetObject GI.Gtk.Label builder "file-chooser-button-label" + fileChooserEntry <- builderGetObject GI.Gtk.Entry builder "file-chooser-entry" + fileChooserWidget <- builderGetObject GI.Gtk.FileChooserWidget builder "file-chooser-widget" + videoWidgetBox <- builderGetObject GI.Gtk.Box builder "video-widget-box" + bottomControlsGtkBox <- builderGetObject GI.Gtk.Box builder "bottom-controls-gtk-box" + seekScale <- builderGetObject GI.Gtk.Scale builder "seek-scale" + fileChooserButton <- builderGetObject GI.Gtk.Button builder "file-chooser-button" + fileChooserCancelButton <- builderGetObject GI.Gtk.Button builder "file-chooser-cancel-button" + fileChooserOpenButton <- builderGetObject GI.Gtk.Button builder "file-chooser-open-button" + playPauseButton <- builderGetObject GI.Gtk.Button builder "play-pause-button" + fullscreenButton <- builderGetObject GI.Gtk.Button builder "fullscreen-button" + aboutButton <- builderGetObject GI.Gtk.Button builder "about-button" + repeatCheckButton <- builderGetObject GI.Gtk.CheckButton builder "repeat-check-button" + volumeButton <- builderGetObject GI.Gtk.VolumeButton builder "volume-button" + playImage <- builderGetObject GI.Gtk.Image builder "play-image" + pauseImage <- builderGetObject GI.Gtk.Image builder "pause-image" + windowWidthSelectionComboBoxText <- builderGetObject GI.Gtk.ComboBoxText builder "window-width-selection-combo-box-text" + subtitleSelectionComboBoxText <- builderGetObject GI.Gtk.ComboBoxText builder "subtitle-selection-combo-box-text" + bufferingSpinner <- builderGetObject GI.Gtk.Spinner builder "buffering-spinner" + fileChooserDialog <- builderGetObject GI.Gtk.Dialog builder "file-chooser-dialog" + errorMessageDialog <- builderGetObject GI.Gtk.MessageDialog builder "error-message-dialog" + aboutDialog <- builderGetObject GI.Gtk.AboutDialog builder "about-dialog" logoFile <- getDataFileName "data/movie-monad-logo.svg" logo <- GI.GdkPixbuf.pixbufNewFromFile (pack logoFile) @@ -87,17 +92,18 @@ GI.Gtk.dialogAddActionWidget fileChooserDialog fileChooserCancelButton (enumToInt32 GI.Gtk.ResponseTypeCancel) GI.Gtk.dialogAddActionWidget fileChooserDialog fileChooserOpenButton (enumToInt32 GI.Gtk.ResponseTypeOk) - isWindowFullScreenRef <- newIORef False - mouseMovedLastRef <- newIORef 0 + isWindowFullScreenRef <- newIORef False + mouseMovedLastRef <- newIORef 0 previousFileNamePathRef <- newIORef "" - videoInfoRef <- newIORef R.defaultVideoInfo + videoInfoRef <- newIORef R.defaultVideoInfo - let ioRefs = R.IORefs { - R.isWindowFullScreenRef = isWindowFullScreenRef - , R.mouseMovedLastRef = mouseMovedLastRef - , R.previousFileNamePathRef = previousFileNamePathRef - , R.videoInfoRef = videoInfoRef - } + let ioRefs = + R.IORefs + { R.isWindowFullScreenRef = isWindowFullScreenRef + , R.mouseMovedLastRef = mouseMovedLastRef + , R.previousFileNamePathRef = previousFileNamePathRef + , R.videoInfoRef = videoInfoRef + } playbin <- fromJust <$> GI.Gst.elementFactoryMake "playbin" (Just "MultimediaPlayerPlaybin") maybeGtkSink <- GI.Gst.elementFactoryMake "gtksink" (Just "MultimediaPlayerGtkSink") @@ -114,73 +120,82 @@ Data.GI.Base.Properties.setObjectPropertyObject playbin "video-sink" maybeGtkSink Data.GI.Base.Properties.setObjectPropertyBool playbin "force-aspect-ratio" True GI.Gtk.boxPackStart videoWidgetBox videoWidget True True 0 - GI.Gtk.widgetSetHexpand videoWidget True - GI.Gtk.widgetSetVexpand videoWidget True + GI.Gtk.widgetSetHexpand videoWidget True + GI.Gtk.widgetSetVexpand videoWidget True GI.Gtk.widgetSetSensitive videoWidget True turnOffSubtitles playbin playbinBus <- GI.Gst.elementGetBus playbin - let guiObjects = R.GuiObjects { - R.window = window - , R.fileChooserButton = fileChooserButton - , R.fileChooserButtonLabel = fileChooserButtonLabel - , R.fileChooserDialog = fileChooserDialog - , R.fileChooserEntry = fileChooserEntry - , R.fileChooserWidget = fileChooserWidget - , R.fileChooserCancelButton = fileChooserCancelButton - , R.fileChooserOpenButton = fileChooserOpenButton - , R.videoWidget = videoWidget - , R.bottomControlsGtkBox = bottomControlsGtkBox - , R.seekScale = seekScale - , R.playPauseButton = playPauseButton - , R.playImage = playImage - , R.pauseImage = pauseImage - , R.volumeButton = volumeButton - , R.videoWidthSelectionComboBox = videoWidthSelectionComboBox - , R.subtitleSelectionComboBox = subtitleSelectionComboBox - , R.fullscreenButton = fullscreenButton - , R.bufferingSpinner = bufferingSpinner - , R.errorMessageDialog = errorMessageDialog - , R.aboutButton = aboutButton - , R.aboutDialog = aboutDialog - } + let guiObjects = + R.GuiObjects + { R.window = window + , R.fileChooserButtonLabel = fileChooserButtonLabel + , R.fileChooserEntry = fileChooserEntry + , R.fileChooserWidget = fileChooserWidget + , R.fileChooserCancelButton = fileChooserCancelButton + , R.fileChooserOpenButton = fileChooserOpenButton + , R.videoWidget = videoWidget + , R.bottomControlsGtkBox = bottomControlsGtkBox + , R.seekScale = seekScale + , R.fileChooserButton = fileChooserButton + , R.playPauseButton = playPauseButton + , R.fullscreenButton = fullscreenButton + , R.volumeButton = volumeButton + , R.repeatCheckButton = repeatCheckButton + , R.playImage = playImage + , R.pauseImage = pauseImage + , R.windowWidthSelectionComboBoxText = windowWidthSelectionComboBoxText + , R.subtitleSelectionComboBoxText = subtitleSelectionComboBoxText + , R.bufferingSpinner = bufferingSpinner + , R.errorMessageDialog = errorMessageDialog + , R.fileChooserDialog = fileChooserDialog + , R.aboutButton = aboutButton + , R.aboutDialog = aboutDialog + } - let application = R.Application { - R.guiObjects = guiObjects - , R.ioRefs = ioRefs - , R.playbin = playbin - , R.playbinBus = playbinBus - } + let application = + R.Application + { R.guiObjects = guiObjects + , R.ioRefs = ioRefs + , R.playbin = playbin + , R.playbinBus = playbinBus + } - addWindowHandlers application [playVideoFromCommandLineIfNeeded] - addPlaybinHandlers application - addFileChooserHandlers application - addPlayPauseButtonClickHandler application - addSeekHandlers application - addVideoSizeSelectorHandler application - addSubtitleSelectorHandler application + addWindowHandlers application [playVideoFromCommandLineIfNeeded] + addPlaybinHandlers application + addFileChooserHandlers application + addPlayPauseButtonClickHandler application + addSeekHandlers application + addVideoSizeSelectorHandlers application + addSubtitleSelectorHandler application addFullscreenButtonReleaseHandler application - addMouseMoveHandlers application [fillWindowWithVideo] - addAboutHandler application - addKeyboardEventHandler application - addErrorMessageDialogHandler application + addMouseMoveHandlers application [fillWindowWithVideo] + addAboutHandler application + addKeyboardEventHandler application + addErrorMessageDialogHandler application let operatingSystem = System.Info.os screenAndPowerManagementActions <- ScreensaverAndPowerManagement.disable operatingSystem + applyCss guiObjects + GI.Gtk.widgetShowAll window + GI.Gtk.main + resetPlaybin playbin + ScreensaverAndPowerManagement.enable operatingSystem screenAndPowerManagementActions -builderGetObject :: - (GI.GObject.GObject b, GI.Gtk.IsBuilder a) => - (Data.GI.Base.ManagedPtr b -> b) -> - a -> - Prelude.String -> - IO b +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 + diff --git a/src/Mouse.hs b/src/Mouse.hs --- a/src/Mouse.hs +++ b/src/Mouse.hs @@ -1,8 +1,9 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} +{-# LANGUAGE OverloadedStrings #-} module Mouse where @@ -18,43 +19,51 @@ addMouseMoveHandlers :: R.Application -> [R.Application -> IO ()] -> IO () addMouseMoveHandlers - application@R.Application { - R.guiObjects = R.GuiObjects { - R.videoWidget = videoWidget - , R.seekScale = seekScale + application@R.Application + { R.guiObjects = + R.GuiObjects + { R.videoWidget = videoWidget + , R.seekScale = seekScale } } onMouseMoveCallbacks - = - void (GI.Gtk.onWidgetMotionNotifyEvent videoWidget mouseMoveHandler') - >> void (GI.Gtk.onWidgetMotionNotifyEvent seekScale mouseMoveHandler') + = do + void $ GI.Gtk.onWidgetMotionNotifyEvent videoWidget mouseMoveHandler' + void $ GI.Gtk.onWidgetMotionNotifyEvent seekScale mouseMoveHandler' where mouseMoveHandler' :: GI.Gdk.EventMotion -> IO Bool mouseMoveHandler' = mouseMoveHandler application onMouseMoveCallbacks mouseMoveHandler - :: R.Application - -> [R.Application -> IO ()] - -> GI.Gdk.EventMotion - -> IO Bool + :: R.Application + -> [R.Application -> IO ()] + -> GI.Gdk.EventMotion + -> IO Bool mouseMoveHandler - application@R.Application { - R.guiObjects = R.GuiObjects { - R.window = window - , R.fileChooserButton = fileChooserButton - , R.bottomControlsGtkBox = bottomControlsGtkBox + application@R.Application + { R.guiObjects = + R.GuiObjects + { R.window = window + , R.fileChooserButton = fileChooserButton + , R.bottomControlsGtkBox = bottomControlsGtkBox } - , R.ioRefs = R.IORefs { - R.isWindowFullScreenRef = isWindowFullScreenRef - , R.mouseMovedLastRef = mouseMovedLastRef - } + , R.ioRefs = + R.IORefs + { R.isWindowFullScreenRef = isWindowFullScreenRef + , R.mouseMovedLastRef = mouseMovedLastRef + , R.videoInfoRef = videoInfoRef + } } onMouseMoveCallbacks _ = do isWindowFullScreen <- readIORef isWindowFullScreenRef + videoInfo <- readIORef videoInfoRef unless isWindowFullScreen $ GI.Gtk.widgetShow fileChooserButton - GI.Gtk.widgetShow bottomControlsGtkBox + when (R.isVideo videoInfo) $ do + GI.Gtk.widgetShow bottomControlsGtkBox + styleContext <- GI.Gtk.widgetGetStyleContext bottomControlsGtkBox + GI.Gtk.styleContextAddClass styleContext "movie-monad-fade-in" setCursor window Nothing timeNow <- getPOSIXTime atomicWriteIORef mouseMovedLastRef (round timeNow) diff --git a/src/PlayPause.hs b/src/PlayPause.hs --- a/src/PlayPause.hs +++ b/src/PlayPause.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -18,26 +18,31 @@ addPlayPauseButtonClickHandler :: R.Application -> IO () addPlayPauseButtonClickHandler - application@R.Application { - R.guiObjects = R.GuiObjects { - R.playPauseButton = playPauseButton + application@R.Application + { R.guiObjects = + R.GuiObjects + { R.playPauseButton = playPauseButton } } = - void $ GI.Gtk.onWidgetButtonReleaseEvent playPauseButton (playPauseButtonClickHandler application) + void $ + GI.Gtk.onWidgetButtonReleaseEvent + playPauseButton $ + playPauseButtonClickHandler application playPauseButtonClickHandler :: R.Application -> GI.Gdk.EventButton -> IO Bool playPauseButtonClickHandler - R.Application { - R.guiObjects = R.GuiObjects { - R.playPauseButton = playPauseButton - , R.playImage = playImage - , R.pauseImage = pauseImage + R.Application + { R.guiObjects = + R.GuiObjects + { R.playPauseButton = playPauseButton + , R.playImage = playImage + , R.pauseImage = pauseImage } - , R.playbin = playbin + , R.playbin = playbin } _ = do @@ -51,22 +56,20 @@ void $ GI.Gst.elementSetState playbin GI.Gst.StatePlaying return False -setPlayPauseButton :: - GI.Gtk.Button -> - GI.Gtk.Image -> - GI.Gtk.Image -> - Bool -> - IO () +setPlayPauseButton + :: GI.Gtk.Button + -> GI.Gtk.Image + -> GI.Gtk.Image + -> Bool + -> IO () setPlayPauseButton playPauseButton _ pauseImage True = do GI.Gtk.buttonSetImage playPauseButton (Just pauseImage) - GI.Gtk.widgetSetTooltipText playPauseButton (Just "Click to pause") + GI.Gtk.widgetSetTooltipText playPauseButton (Just "Click to Pause") setPlayPauseButton playPauseButton playImage _ False = do GI.Gtk.buttonSetImage playPauseButton (Just playImage) - GI.Gtk.widgetSetTooltipText playPauseButton (Just "Click to play") + GI.Gtk.widgetSetTooltipText playPauseButton (Just "Click to Play") -isPlayPauseButtonPlaying :: - GI.Gtk.Button -> - IO Bool +isPlayPauseButtonPlaying :: GI.Gtk.Button -> IO Bool isPlayPauseButtonPlaying playPauseButton = GI.Gtk.buttonGetImage playPauseButton >>= getImage >>= getName >>= getMatch where @@ -75,7 +78,7 @@ getImage (Just widget) = GI.Gtk.castTo GI.Gtk.Image widget getName :: Maybe GI.Gtk.Image -> IO (Maybe Text) getName Nothing = return Nothing - getName (Just image) = GI.Gtk.getImageStock image + getName (Just image) = Just . Data.Text.strip . Data.Text.toLower <$> GI.Gtk.widgetGetName image getMatch :: Maybe Text -> IO Bool getMatch Nothing = return False - getMatch (Just text) = return ("gtk-media-pause" == text) + getMatch (Just text) = return ("pause-image" == text) diff --git a/src/Playbin.hs b/src/Playbin.hs --- a/src/Playbin.hs +++ b/src/Playbin.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -14,6 +14,7 @@ import Data.Bits import Data.Text import Data.Maybe +import Data.Int import Data.GI.Base.Properties import Data.GI.Base.ManagedPtr import qualified GI.GLib @@ -21,7 +22,7 @@ import qualified GI.Gst import qualified Records as R -import Window +import Reset import PlayPause import ErrorMessage import Uri @@ -31,69 +32,72 @@ addPlaybinHandlers :: R.Application -> IO () addPlaybinHandlers - R.Application { - R.guiObjects = guiObjects@R.GuiObjects { - R.volumeButton = volumeButton + application@R.Application + { R.guiObjects = + R.GuiObjects + { R.volumeButton = volumeButton + , R.repeatCheckButton = repeatCheckButton } - , R.playbin = playbin - , R.playbinBus = playbinBus + , R.playbin = playbin + , R.playbinBus = playbinBus } - = - void( - GI.Gst.busAddWatch playbinBus GI.GLib.PRIORITY_DEFAULT ( - pipelineBusMessageHandler - guiObjects - playbin - ) - ) >> - void ( - GI.Gtk.onScaleButtonValueChanged volumeButton (volumeButtonValueChangedHandler playbin) - ) + = do + void $ + GI.Gst.busAddWatch playbinBus GI.GLib.PRIORITY_DEFAULT $ + pipelineBusMessageHandler application + void $ + GI.Gtk.onScaleButtonValueChanged + volumeButton + (setPlaybinVolume playbin) + void $ + GI.GLib.timeoutAddSeconds GI.GLib.PRIORITY_DEFAULT 1 $ do + rewindPlaybackIfVideoEndedAndRepeat + playbin + repeatCheckButton + return True -pipelineBusMessageHandler :: - R.GuiObjects -> - GI.Gst.Element -> - GI.Gst.Bus -> - GI.Gst.Message -> - IO Bool pipelineBusMessageHandler - guiObjects@R.GuiObjects { - R.seekScale = seekScale - , R.fileChooserEntry = fileChooserEntry - , R.fileChooserButtonLabel = fileChooserButtonLabel - , R.volumeButton = volumeButton - , R.errorMessageDialog = errorMessageDialog - , R.bufferingSpinner = bufferingSpinner - , R.playPauseButton = playPauseButton - , R.subtitleSelectionComboBox = subtitleSelectionComboBox + :: R.Application + -> GI.Gst.Bus + -> GI.Gst.Message + -> IO Bool +pipelineBusMessageHandler + application@R.Application + { R.guiObjects = + R.GuiObjects + { R.seekScale = seekScale + , R.fileChooserEntry = fileChooserEntry + , R.fileChooserButtonLabel = fileChooserButtonLabel + , R.errorMessageDialog = errorMessageDialog + , R.bufferingSpinner = bufferingSpinner + , R.playPauseButton = playPauseButton + , R.repeatCheckButton = repeatCheckButton + , R.subtitleSelectionComboBoxText = subtitleSelectionComboBoxText + } + , R.playbin = playbin } - playbin _ message = do messageTypes <- GI.Gst.getMessageType message - let messageType = case messageTypes of - [] -> GI.Gst.MessageTypeUnknown - (msg:_) -> msg + let messageType = + case messageTypes of + [] -> GI.Gst.MessageTypeUnknown + (msg:_) -> msg entryText <- GI.Gtk.entryGetText fileChooserEntry labelText <- GI.Gtk.labelGetText fileChooserButtonLabel - when ( - messageType == GI.Gst.MessageTypeError && ( - (not . Data.Text.null) entryText || - labelText /= "Open" - ) + when + ( messageType == GI.Gst.MessageTypeError + && ((not . Data.Text.null) entryText || labelText /= "Open") ) $ do (gError, text) <- GI.Gst.messageParseError message gErrorText <- GI.Gst.gerrorMessage gError 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 - setPlaybinUriAndVolume playbin "" volumeButton - resetWindow guiObjects + resetApplication application runErrorMessageDialog - errorMessageDialog - (Data.Text.concat ["There was a problem trying to play the video \"", entryText, "\"."]) + errorMessageDialog $ + Data.Text.concat + ["There was a problem trying to play the video \"", entryText, "\"."] when (messageType == GI.Gst.MessageTypeBuffering) $ do percent <- GI.Gst.messageParseBuffering message isPlaying <- isPlayPauseButtonPlaying playPauseButton @@ -102,7 +106,9 @@ GI.Gtk.widgetHide bufferingSpinner GI.Gtk.setSpinnerActive bufferingSpinner False GI.Gtk.widgetSetSensitive seekScale True - when isPlaying $ void $ GI.Gst.elementSetState playbin GI.Gst.StatePlaying + when isPlaying $ + void $ + GI.Gst.elementSetState playbin GI.Gst.StatePlaying else do GI.Gtk.widgetShow bufferingSpinner GI.Gtk.setSpinnerActive bufferingSpinner True @@ -112,41 +118,72 @@ when (messageType == GI.Gst.MessageTypeStreamStart) $ do turnOffSubtitles playbin nText <- getTextStreamCount playbin - GI.Gtk.comboBoxTextRemoveAll subtitleSelectionComboBox + GI.Gtk.comboBoxTextRemoveAll subtitleSelectionComboBoxText GI.Gtk.comboBoxTextAppend - subtitleSelectionComboBox + subtitleSelectionComboBoxText (Just "-1") "None" - _ <- GI.Gtk.comboBoxSetActiveId subtitleSelectionComboBox (Just "-1") - GI.Gtk.widgetHide subtitleSelectionComboBox + _ <- GI.Gtk.comboBoxSetActiveId subtitleSelectionComboBoxText (Just "-1") + GI.Gtk.widgetHide subtitleSelectionComboBoxText when (nText > 0) $ mapM_ (\ i -> do (_, maybeCode) <- getTextTagLanguageNameAndCode playbin i case maybeCode of Nothing -> return () Just code -> do - GI.Gtk.widgetShow subtitleSelectionComboBox + GI.Gtk.widgetShow subtitleSelectionComboBoxText GI.Gtk.comboBoxTextAppend - subtitleSelectionComboBox + subtitleSelectionComboBoxText (Just (Data.Text.pack (show i))) code ) [0..(nText-1)] + when (messageType == GI.Gst.MessageTypeEos) $ + rewindPlaybackIfRepeat playbin repeatCheckButton return True -volumeButtonValueChangedHandler :: - GI.Gst.Element -> - Double -> - IO () -volumeButtonValueChangedHandler playbin volume = +rewindPlaybackIfVideoEndedAndRepeat :: GI.Gst.Element -> GI.Gtk.CheckButton -> IO () +rewindPlaybackIfVideoEndedAndRepeat playbin repeatCheckButton = do + maybeDurationAndPosition <- queryPlaybinForDurationAndPosition playbin + case maybeDurationAndPosition of + (Just (duration, position)) -> + -- Position may never be >= duration even though an EOS event has occurred. + -- Allow for a half second tolerance. + when (position >= duration || ((duration - position) < 50000000)) $ + rewindPlaybackIfRepeat playbin repeatCheckButton + _ -> return () + +rewindPlaybackIfRepeat :: GI.Gst.Element -> GI.Gtk.CheckButton -> IO () +rewindPlaybackIfRepeat playbin repeatCheckButton = do + repeatVideo <- GI.Gtk.toggleButtonGetActive repeatCheckButton + when repeatVideo $ + void $ + GI.Gst.elementSeekSimple playbin GI.Gst.FormatTime [ GI.Gst.SeekFlagsFlush ] 0 + +setPlaybinVolume :: GI.Gst.Element -> Double -> IO () +setPlaybinVolume playbin volume = void $ Data.GI.Base.Properties.setObjectPropertyDouble playbin "volume" volume +setPlaybinUri :: GI.Gst.Element -> Maybe String -> IO () +setPlaybinUri playbin (Just uri) = + void $ Data.GI.Base.Properties.setObjectPropertyString playbin "uri" (Just $ pack uri) +setPlaybinUri playbin Nothing = + void $ Data.GI.Base.Properties.setObjectPropertyString playbin "uri" (Just "") + setPlaybinUriAndVolume :: GI.Gst.Element -> Prelude.String -> GI.Gtk.VolumeButton -> IO () setPlaybinUriAndVolume playbin fileName volumeButton = do - uri <- addUriSchemeIfNone fileName + 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) + setPlaybinVolume playbin volume + setPlaybinUri playbin (Just uri) +queryPlaybinForDurationAndPosition :: GI.Gst.Element -> IO (Maybe (Int64, Int64)) +queryPlaybinForDurationAndPosition playbin = do + (couldQueryDuration, duration) <- GI.Gst.elementQueryDuration playbin GI.Gst.FormatTime + (couldQueryPosition, position) <- GI.Gst.elementQueryPosition playbin GI.Gst.FormatTime + if couldQueryDuration && couldQueryPosition && duration > 0 && position >= 0 + then return (Just (duration, position)) + else return Nothing + getTextTagLanguageNameAndCode :: GI.Gst.Element -> Int -> IO (Maybe Text, Maybe Text) getTextTagLanguageNameAndCode playbin streamId = do nText <- getTextStreamCount playbin @@ -160,15 +197,17 @@ 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 + (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) @@ -198,13 +237,17 @@ 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) + 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) + 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) + 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 @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -11,67 +11,74 @@ import qualified GI.Gtk import qualified GI.Gst -data VideoInfo = VideoInfo { - uri :: Prelude.String +data Application = + Application + { guiObjects :: GuiObjects + , ioRefs :: IORefs + , playbin :: GI.Gst.Element + , playbinBus :: GI.Gst.Bus + } + +data GuiObjects = + GuiObjects + { window :: GI.Gtk.Window + , fileChooserButtonLabel :: GI.Gtk.Label + , fileChooserDialog :: GI.Gtk.Dialog + , fileChooserEntry :: GI.Gtk.Entry + , fileChooserWidget :: GI.Gtk.FileChooserWidget + , videoWidget :: GI.Gtk.Widget + , bottomControlsGtkBox :: GI.Gtk.Box + , seekScale :: GI.Gtk.Scale + , fileChooserButton :: GI.Gtk.Button + , playPauseButton :: GI.Gtk.Button + , fullscreenButton :: GI.Gtk.Button + , fileChooserCancelButton :: GI.Gtk.Button + , fileChooserOpenButton :: GI.Gtk.Button + , aboutButton :: GI.Gtk.Button + , repeatCheckButton :: GI.Gtk.CheckButton + , volumeButton :: GI.Gtk.VolumeButton + , playImage :: GI.Gtk.Image + , pauseImage :: GI.Gtk.Image + , windowWidthSelectionComboBoxText :: GI.Gtk.ComboBoxText + , subtitleSelectionComboBoxText :: GI.Gtk.ComboBoxText + , bufferingSpinner :: GI.Gtk.Spinner + , errorMessageDialog :: GI.Gtk.MessageDialog + , aboutDialog :: GI.Gtk.AboutDialog + } + +data IORefs = + IORefs + { isWindowFullScreenRef :: IORef Bool + , mouseMovedLastRef :: IORef Integer + , previousFileNamePathRef :: IORef Data.Text.Text + , videoInfoRef :: IORef VideoInfo + } + +data VideoInfo = + VideoInfo + { uri :: Prelude.String , isLocalFile :: Bool , isVideo :: Bool , isSeekable :: Bool , videoWidth :: Int , videoHeight :: Int - } + } +data ScreensaverAndPowerManagementActions = + ScreensaverAndPowerManagementActions + { disabledPowerManagement :: Bool + , disabledXScreensaver :: Bool + , disabledCinnamonScreensaver :: Bool + , disabledGnomeScreensaver :: Bool + } + defaultVideoInfo :: VideoInfo -defaultVideoInfo = VideoInfo { - uri = "" +defaultVideoInfo = + VideoInfo + { uri = "" , isLocalFile = False , isVideo = False , isSeekable = False , videoWidth = 800 , videoHeight = 600 - } - -data GuiObjects = GuiObjects { - window :: GI.Gtk.Window - , fileChooserButton :: GI.Gtk.Button - , fileChooserButtonLabel :: GI.Gtk.Label - , fileChooserDialog :: GI.Gtk.Dialog - , fileChooserEntry :: GI.Gtk.Entry - , fileChooserWidget :: GI.Gtk.FileChooserWidget - , fileChooserCancelButton :: GI.Gtk.Button - , fileChooserOpenButton :: GI.Gtk.Button - , videoWidget :: GI.Gtk.Widget - , bottomControlsGtkBox :: GI.Gtk.Box - , seekScale :: GI.Gtk.Scale - , playPauseButton :: GI.Gtk.Button - , playImage :: GI.Gtk.Image - , 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 - , aboutButton :: GI.Gtk.Button - , aboutDialog :: GI.Gtk.AboutDialog - } - -data IORefs = IORefs { - isWindowFullScreenRef :: IORef Bool - , mouseMovedLastRef :: IORef Integer - , previousFileNamePathRef :: IORef Data.Text.Text - , videoInfoRef :: IORef VideoInfo - } - -data ScreensaverAndPowerManagementActions = ScreensaverAndPowerManagementActions { - disabledPowerManagement :: Bool - , disabledXScreensaver :: Bool - , disabledCinnamonScreensaver :: Bool - , disabledGnomeScreensaver :: Bool - } - -data Application = Application { - guiObjects :: GuiObjects - , ioRefs :: IORefs - , playbin :: GI.Gst.Element - , playbinBus :: GI.Gst.Bus - } + } diff --git a/src/Reset.hs b/src/Reset.hs new file mode 100644 --- /dev/null +++ b/src/Reset.hs @@ -0,0 +1,97 @@ +{- + Movie Monad + (C) 2017 David Lettier + lettier.com +-} + +{-# LANGUAGE OverloadedStrings #-} + +module Reset where + +import Control.Monad +import Data.Int +import Data.IORef +import Data.GI.Base.Properties +import qualified GI.Gtk +import qualified GI.Gst + +import qualified Records as R +import Constants +import Mouse +import VideoInfo +import PlayPause +import Utils + +resetApplication :: R.Application -> IO () +resetApplication + R.Application + { R.guiObjects = guiObjects + , R.playbin = playbin + , R.ioRefs = ioRefs + } + = do + resetIoRefs ioRefs + resetPlaybin playbin + resetGuiObjects guiObjects + +resetIoRefs :: R.IORefs -> IO () +resetIoRefs + R.IORefs + { R.videoInfoRef = videoInfoRef + , R.previousFileNamePathRef = previousFileNamePathRef + } + = do + void $ resetVideoInfo videoInfoRef + atomicWriteIORef previousFileNamePathRef "" + +resetVideoInfo :: IORef R.VideoInfo -> IO R.VideoInfo +resetVideoInfo videoInfoRef = do + let videoInfo = R.defaultVideoInfo + saveVideoInfo videoInfoRef videoInfo + return videoInfo + +resetPlaybin :: GI.Gst.Element -> IO () +resetPlaybin playbin = do + void $ GI.Gst.elementSetState playbin GI.Gst.StateNull + void $ Data.GI.Base.Properties.setObjectPropertyDouble playbin "volume" 0.0 + void $ Data.GI.Base.Properties.setObjectPropertyString playbin "uri" (Just "") + +resetGuiObjects :: R.GuiObjects -> IO () +resetGuiObjects + R.GuiObjects + { R.window = window + , R.fileChooserButton = fileChooserButton + , R.fileChooserEntry = fileChooserEntry + , R.fileChooserButtonLabel = fileChooserButtonLabel + , R.videoWidget = videoWidget + , R.seekScale = seekScale + , R.playPauseButton = playPauseButton + , R.repeatCheckButton = repeatCheckButton + , R.windowWidthSelectionComboBoxText = windowWidthSelectionComboBoxText + , R.subtitleSelectionComboBoxText = subtitleSelectionComboBoxText + , R.fullscreenButton = fullscreenButton + , R.playImage = playImage + , R.pauseImage = pauseImage + , R.bottomControlsGtkBox = bottomControlsGtkBox + } + = do + desiredWindowWidth <- getDesiredWindowWidth windowWidthSelectionComboBoxText window + styleContext <- GI.Gtk.widgetGetStyleContext bottomControlsGtkBox + GI.Gtk.widgetSetSizeRequest window windowMinimumSize (-1) + GI.Gtk.windowUnfullscreen window + GI.Gtk.widgetHide videoWidget + GI.Gtk.widgetHide bottomControlsGtkBox + GI.Gtk.widgetHide seekScale + GI.Gtk.widgetHide playPauseButton + GI.Gtk.widgetHide repeatCheckButton + GI.Gtk.widgetHide fullscreenButton + GI.Gtk.widgetHide subtitleSelectionComboBoxText + GI.Gtk.widgetShow fileChooserButton + GI.Gtk.widgetShow windowWidthSelectionComboBoxText + GI.Gtk.setToggleButtonActive repeatCheckButton False + GI.Gtk.entrySetText fileChooserEntry "" + GI.Gtk.labelSetText fileChooserButtonLabel "Open" + GI.Gtk.windowResize window (fromIntegral desiredWindowWidth :: Int32) 1 + GI.Gtk.styleContextRemoveClass styleContext "movie-monad-fade-in" + setCursor window Nothing + setPlayPauseButton playPauseButton playImage pauseImage False diff --git a/src/ScreensaverAndPowerManagement.hs b/src/ScreensaverAndPowerManagement.hs --- a/src/ScreensaverAndPowerManagement.hs +++ b/src/ScreensaverAndPowerManagement.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} diff --git a/src/Seek.hs b/src/Seek.hs --- a/src/Seek.hs +++ b/src/Seek.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -8,7 +8,6 @@ import Control.Monad import Data.IORef -import Data.Int import Data.GI.Base.Signals import GI.GLib import GI.GObject @@ -16,73 +15,87 @@ import qualified GI.Gst import qualified Records as R +import Playbin +import Utils addSeekHandlers :: R.Application -> IO () addSeekHandlers - R.Application { - R.guiObjects = R.GuiObjects { - R.seekScale = seekScale + R.Application + { R.guiObjects = + R.GuiObjects + { R.seekScale = seekScale } - , R.ioRefs = R.IORefs { - R.videoInfoRef = videoInfoRef - } - , R.playbin = playbin + , R.ioRefs = + R.IORefs + { R.videoInfoRef = videoInfoRef + } + , R.playbin = playbin } = do - seekScaleHandlerId <- GI.Gtk.onRangeValueChanged seekScale ( + seekScaleHandlerId <- + GI.Gtk.onRangeValueChanged seekScale $ onRangeValueChanged playbin seekScale videoInfoRef - ) - void ( - GI.GLib.timeoutAdd GI.GLib.PRIORITY_DEFAULT 41 ( - updateSeekScale - playbin - seekScale - seekScaleHandlerId - ) - ) + void $ + GI.GLib.timeoutAdd GI.GLib.PRIORITY_DEFAULT 41 $ + updateSeekScale + playbin + seekScale + seekScaleHandlerId -onRangeValueChanged :: - GI.Gst.Element -> - GI.Gtk.Scale -> - IORef R.VideoInfo -> - IO () +onRangeValueChanged :: GI.Gst.Element -> GI.Gtk.Scale -> IORef R.VideoInfo -> IO () onRangeValueChanged playbin seekScale videoInfoRef = 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 - videoInfoGathered <- readIORef videoInfoRef - -- When playing over a network (not local), - -- sending too many asynchronous seek requests will cause GStreamer to error. - -- Block until this seek request finishes which will block the main GTK main thread. - -- Note that by blocking here, the seek scale will not slide. - -- The user will have to point and click on the scale track. - unless (R.isLocalFile videoInfoGathered) $ void $ GI.Gst.elementGetState playbin GI.Gst.CLOCK_TIME_NONE + maybeDurationAndPosition <- queryPlaybinForDurationAndPosition playbin + case maybeDurationAndPosition of + (Just (duration, _)) -> do + percentage <- clamp 0.0 1.0 . flip (/) 100.0 . clamp 0.0 100.0 <$> GI.Gtk.rangeGetValue seekScale + let position = + clamp 0 duration $ + doubleToInt64 $ + int64toDouble duration * percentage + void $ GI.Gst.elementSeekSimple playbin GI.Gst.FormatTime [ GI.Gst.SeekFlagsFlush ] position + videoInfo <- readIORef videoInfoRef + -- When playing over a network (not local), + -- sending too many asynchronous seek requests will cause GStreamer to error. + -- Block until this seek request finishes which will block the main GTK main thread. + -- Note that by blocking here, the seek scale will not slide. + -- The user will have to point and click on the scale track. + unless (R.isLocalFile videoInfo) $ + void $ + GI.Gst.elementGetState playbin GI.Gst.CLOCK_TIME_NONE + _ -> return () -updateSeekScale :: - GI.Gst.Element -> - GI.Gtk.Scale -> - Data.GI.Base.Signals.SignalHandlerId -> - IO Bool 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 - when (couldQueryDuration && couldQueryPosition && duration > 0) $ do - let percentage = 100.0 * (fromIntegral position / fromIntegral duration :: Double) - GI.GObject.signalHandlerBlock seekScale seekScaleHandlerId - GI.Gtk.rangeSetValue seekScale percentage - GI.GObject.signalHandlerUnblock seekScale seekScaleHandlerId + maybeDurationAndPosition <- queryPlaybinForDurationAndPosition playbin + case maybeDurationAndPosition of + (Just (duration, position)) -> + when (duration > 0) $ do + let percentage = 100.0 * (int64toDouble position / int64toDouble duration) + GI.GObject.signalHandlerBlock seekScale seekScaleHandlerId + GI.Gtk.rangeSetValue seekScale percentage + GI.GObject.signalHandlerUnblock seekScale seekScaleHandlerId + _ -> return () return True + +hideOrShowSeekScale :: GI.Gtk.Scale -> Bool -> IO () +hideOrShowSeekScale seekScale True = do + GI.Gtk.widgetSetSensitive seekScale True + GI.Gtk.widgetShow seekScale +hideOrShowSeekScale seekScale False = do + GI.Gtk.widgetSetSensitive seekScale False + GI.Gtk.widgetHide seekScale diff --git a/src/SubtitleSelector.hs b/src/SubtitleSelector.hs --- a/src/SubtitleSelector.hs +++ b/src/SubtitleSelector.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -17,12 +17,12 @@ addSubtitleSelectorHandler application@R.Application { R.guiObjects = R.GuiObjects { - R.subtitleSelectionComboBox = subtitleSelectionComboBox + R.subtitleSelectionComboBoxText = subtitleSelectionComboBoxText } } = void ( GI.Gtk.onComboBoxChanged - subtitleSelectionComboBox + subtitleSelectionComboBoxText (subtitleSelectorHandler application) ) @@ -30,12 +30,12 @@ subtitleSelectorHandler R.Application { R.guiObjects = R.GuiObjects { - R.subtitleSelectionComboBox = subtitleSelectionComboBox + R.subtitleSelectionComboBoxText = subtitleSelectionComboBoxText } , R.playbin = playbin } = do - maybeActiveId <- GI.Gtk.getComboBoxActiveId subtitleSelectionComboBox + maybeActiveId <- GI.Gtk.getComboBoxActiveId subtitleSelectionComboBoxText nText <- getTextStreamCount playbin case maybeActiveId of Nothing -> return () diff --git a/src/Uri.hs b/src/Uri.hs --- a/src/Uri.hs +++ b/src/Uri.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -49,14 +49,16 @@ else if hasHttpUriScheme filePathName then filePathName else "http://" ++ filePathName isLocalFile :: Prelude.String -> IO Bool -isLocalFile = Filesystem.isFile . Filesystem.Path.CurrentOS.fromText . Data.Text.pack . removeFileUriScheme +isLocalFile = + Filesystem.isFile . Filesystem.Path.CurrentOS.fromText . Data.Text.pack . removeFileUriScheme toAbsoluteUri :: String -> IO String toAbsoluteUri uri = do cwd <- getWorkingDirectory - let cwd' = case toText cwd of - Right x -> x - Left y -> y + let cwd' = + case toText cwd of + Right x -> x + Left y -> y isLocal <- isLocalFile uri if not isLocal then return uri diff --git a/src/Utils.hs b/src/Utils.hs --- a/src/Utils.hs +++ b/src/Utils.hs @@ -1,11 +1,9 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} -{-# LANGUAGE ScopedTypeVariables #-} - module Utils where import System.Exit @@ -13,6 +11,7 @@ import System.FilePath import Control.Monad import Control.Exception +import Text.Read import Data.List import Data.Text import Data.Int @@ -24,12 +23,36 @@ enumToInt32 :: (Enum a, Ord a) => a -> Int32 enumToInt32 enum = fromIntegral (fromEnum enum) :: Int32 +int64toDouble :: Int64 -> Double +int64toDouble i = fromIntegral i :: Double + +doubleToInt64 :: Double -> Int64 +doubleToInt64 d = fromIntegral (round d :: Int) :: Int64 + isTextEmpty :: Data.Text.Text -> Bool isTextEmpty = Data.Text.null . Data.Text.strip -getSelectedVideoWidth :: GI.Gtk.ComboBoxText -> IO Int -getSelectedVideoWidth = fmap (\ x -> read (Data.Text.unpack x) :: Int) . GI.Gtk.comboBoxTextGetActiveText +getDesiredWindowWidth :: GI.Gtk.ComboBoxText -> GI.Gtk.Window -> IO Int +getDesiredWindowWidth windowWidthSelectionComboBoxText window = do + maybeSelectedWindowWidth <- getSelectedWindowWidth windowWidthSelectionComboBoxText + case maybeSelectedWindowWidth of + Just selectedWidth -> return selectedWidth + _ -> do + (windowWidth, _) <- GI.Gtk.windowGetSize window + return (fromIntegral windowWidth :: Int) +getSelectedWindowWidth :: GI.Gtk.ComboBoxText -> IO (Maybe Int) +getSelectedWindowWidth windowWidthSelectionComboBoxText = do + activeId <- GI.Gtk.comboBoxGetActive windowWidthSelectionComboBoxText + if activeId == (-1) + then return Nothing + else do + string <- + Data.Text.unpack <$> + GI.Gtk.comboBoxTextGetActiveText + windowWidthSelectionComboBoxText + return (readMaybe string :: Maybe Int) + linuxProcessIsRunning :: String -> IO Bool linuxProcessIsRunning processName = do (_, out, _) <- safeRunProcessGetOutput "pgrep" ["-f", processName] @@ -39,23 +62,25 @@ spawnLinuxProcessAndDisown processCommand = void $ System.Process.spawnCommand - ( - "nohup " - ++ processCommand - ++ " /dev/null & disown" - ) + ( "nohup " + ++ processCommand + ++ " /dev/null & disown" + ) safeRunProcessGetOutput :: String -> [String] -> IO (System.Exit.ExitCode, String, String) safeRunProcessGetOutput processName args = - catch ( + catch readProcess' catchError + where + readProcess' :: IO (System.Exit.ExitCode, String, String) + readProcess' = readProcessWithExitCode processName args "" - ) (\ (e :: Control.Exception.IOException) -> - putStr (show e) >> - return (ExitFailure 1, "", "") - ) + catchError :: Control.Exception.IOException -> IO (System.Exit.ExitCode, String, String) + catchError e = do + putStr $ show e + return (ExitFailure 1, "", "") clamp :: Ord a => a -> a -> a -> a clamp minimum' maximum' el diff --git a/src/VideoInfo.hs b/src/VideoInfo.hs --- a/src/VideoInfo.hs +++ b/src/VideoInfo.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -19,58 +19,64 @@ import Uri import Utils -getVideoInfoRaw :: Prelude.String -> IO (Maybe Prelude.String) -getVideoInfoRaw uri = do +getRawVideoInfo :: Prelude.String -> IO (Maybe Prelude.String) +getRawVideoInfo uri = do (code, out, _) <- safeRunProcessGetOutput "gst-discoverer-1.0" [uri, "-v"] if code == System.Exit.ExitSuccess then return (Just out) else return Nothing -getVideoInfo :: IORef R.VideoInfo -> Prelude.String -> IO R.VideoInfo -getVideoInfo videoInfoRef filePathName = do - videoInfoGathered <- readIORef videoInfoRef - uri <- addUriSchemeIfNone filePathName - cacheDo (R.uri videoInfoGathered == uri) videoInfoGathered uri +processRawVideoInfo :: Maybe Prelude.String -> Prelude.String -> Maybe R.VideoInfo +processRawVideoInfo Nothing _ = Nothing +processRawVideoInfo (Just str) uri = do + let text = Data.Text.toLower $ Data.Text.pack str + let textLines = Data.Text.lines text + let videoInfo = + R.VideoInfo + { R.uri = uri + , R.isLocalFile = hasFileUriScheme uri + , R.isVideo = "video: video/" `Data.Text.isInfixOf` text + , R.isSeekable = "yes" == getField seekableField textLines + , R.videoWidth = getDimension R.videoWidth widthField textLines + , R.videoHeight = getDimension R.videoHeight heightField textLines + } + Just videoInfo where - widthField :: Data.Text.Text - widthField = "width: " - heightField :: Data.Text.Text - heightField = "height: " + widthField :: Data.Text.Text + widthField = "width: " + heightField :: Data.Text.Text + heightField = "height: " seekableField :: Data.Text.Text seekableField = "seekable: " - cacheDo :: Bool -> R.VideoInfo -> Prelude.String -> IO R.VideoInfo - cacheDo True videoInfoGathered _ = return videoInfoGathered - cacheDo False _ uri = do - videoInfoRaw <- getVideoInfoRaw uri - processVideoInfoRaw videoInfoRaw uri - processVideoInfoRaw :: Maybe Prelude.String -> Prelude.String -> IO R.VideoInfo - processVideoInfoRaw Nothing _ = do - let videoInfoGathered = R.defaultVideoInfo - atomicWriteIORef videoInfoRef videoInfoGathered - return videoInfoGathered - processVideoInfoRaw (Just str) uri = do - let text = Data.Text.toLower $ Data.Text.pack str - let textLines = Data.Text.lines text - let videoInfoGathered = R.VideoInfo { - R.uri = uri - , R.isLocalFile = hasFileUriScheme uri - , R.isVideo = "video: video/" `Data.Text.isInfixOf` text - , R.isSeekable = "yes" == getField seekableField textLines - , R.videoWidth = getDimension R.videoWidth widthField textLines - , R.videoHeight = getDimension R.videoHeight heightField textLines - } - atomicWriteIORef videoInfoRef videoInfoGathered - return videoInfoGathered getDimension :: (R.VideoInfo -> Int) -> Data.Text.Text -> [Data.Text.Text] -> Int - getDimension f field lines' = fromMaybe ( - f R.defaultVideoInfo - ) (readMaybe (Data.Text.unpack $ getField field lines') :: Maybe Int) + getDimension f field lines' = + fromMaybe + (f R.defaultVideoInfo) + (readMaybe (Data.Text.unpack $ getField field lines') :: Maybe Int) getField :: Data.Text.Text -> [Data.Text.Text] -> Data.Text.Text getField field = - Prelude.foldl (\ acc l -> + Prelude.foldl + (\ acc l -> if not $ Data.Text.null acc then acc - else if field `Data.Text.isInfixOf` l - then Data.Text.replace field "" $ Data.Text.strip l - else "" - ) "" + else + if field `Data.Text.isInfixOf` l + then Data.Text.replace field "" $ Data.Text.strip l + else "" + ) + "" +getVideoInfo :: IORef R.VideoInfo -> Prelude.String -> IO (Maybe R.VideoInfo) +getVideoInfo videoInfoRef filePathName = do + videoInfo <- readIORef videoInfoRef + uri <- addUriSchemeIfNone filePathName + if R.uri videoInfo == uri + then return $ Just videoInfo + else do + rawVideoInfo <- getRawVideoInfo uri + case processRawVideoInfo rawVideoInfo uri of + (Just videoInfo') -> return $ Just videoInfo' + _ -> return Nothing + +saveVideoInfo :: IORef R.VideoInfo -> R.VideoInfo -> IO () +saveVideoInfo = atomicWriteIORef + diff --git a/src/VideoSizeSelector.hs b/src/VideoSizeSelector.hs --- a/src/VideoSizeSelector.hs +++ b/src/VideoSizeSelector.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -8,42 +8,76 @@ import Control.Monad import Data.Text +import Data.IORef +import qualified GI.GLib import qualified GI.Gtk import qualified Records as R +import Reset import Window -import VideoInfo import Utils -addVideoSizeSelectorHandler :: R.Application -> IO () -addVideoSizeSelectorHandler - application@R.Application { - R.guiObjects = R.GuiObjects { - R.videoWidthSelectionComboBox = videoWidthSelectionComboBox +addVideoSizeSelectorHandlers :: R.Application -> IO () +addVideoSizeSelectorHandlers + application@R.Application + { R.guiObjects = + guiObjects@R.GuiObjects + { R.windowWidthSelectionComboBoxText = windowWidthSelectionComboBoxText } } - = void ( - GI.Gtk.onComboBoxChanged - videoWidthSelectionComboBox - (videoSizeSelectionHandler application) - ) + = do + void $ + GI.Gtk.onComboBoxChanged + windowWidthSelectionComboBoxText $ + videoSizeSelectionHandler application + void $ + GI.GLib.timeoutAddSeconds + GI.GLib.PRIORITY_DEFAULT + 1 $ + setToCustomIfNeeded guiObjects videoSizeSelectionHandler :: R.Application -> IO () videoSizeSelectionHandler - R.Application { - R.guiObjects = guiObjects@R.GuiObjects { - R.videoWidthSelectionComboBox = videoWidthSelectionComboBox - , R.fileChooserEntry = fileChooserEntry + application@R.Application + { R.guiObjects = + guiObjects@R.GuiObjects + { R.window = window + , R.windowWidthSelectionComboBoxText = windowWidthSelectionComboBoxText } - , R.ioRefs = R.IORefs { - R.videoInfoRef = videoInfoRef - } + , R.ioRefs = + R.IORefs + { R.videoInfoRef = videoInfoRef + } } = do - filePathName <- Data.Text.unpack <$> GI.Gtk.entryGetText fileChooserEntry - videoWidthSelection <- getSelectedVideoWidth videoWidthSelectionComboBox - retrievedVideoInfo <- getVideoInfo videoInfoRef filePathName - maybeWindowSize <- calculateWindowSize guiObjects videoWidthSelection retrievedVideoInfo + videoInfo <- readIORef videoInfoRef + desiredWindowWidth <- getDesiredWindowWidth windowWidthSelectionComboBoxText window + maybeWindowSize <- calculateWindowSize guiObjects desiredWindowWidth videoInfo case maybeWindowSize of - Nothing -> resetWindow guiObjects + Nothing -> resetApplication application Just (width, height) -> setWindowSize guiObjects width height + +setToCustomIfNeeded :: R.GuiObjects -> IO Bool +setToCustomIfNeeded + R.GuiObjects + { R.window = window + , R.windowWidthSelectionComboBoxText = windowWidthSelectionComboBoxText + } + = do + (windowWidth', _) <- GI.Gtk.windowGetSize window + maybeSelectedWidth <- getSelectedWindowWidth windowWidthSelectionComboBoxText + let windowWidth = fromIntegral windowWidth' :: Int + case maybeSelectedWidth of + Just selectedWidth -> + when (windowWidth /= selectedWidth) $ + GI.Gtk.comboBoxSetActive windowWidthSelectionComboBoxText (-1) + Nothing -> do + let windowWidthText = Data.Text.pack $ show windowWidth + present <- + GI.Gtk.comboBoxSetActiveId + windowWidthSelectionComboBoxText $ + Just windowWidthText + if present + then return () + else GI.Gtk.comboBoxSetActive windowWidthSelectionComboBoxText (-1) + return True diff --git a/src/Window.hs b/src/Window.hs --- a/src/Window.hs +++ b/src/Window.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} @@ -21,66 +21,67 @@ import qualified Records as R import Constants +import Reset import Mouse import PlayPause -import Utils +import Seek addWindowHandlers :: R.Application -> [R.Application -> IO ()] -> IO () addWindowHandlers - application@R.Application { - R.guiObjects = R.GuiObjects { - R.window = window - , R.videoWidget = videoWidget + application@R.Application + { R.guiObjects = + R.GuiObjects + { R.window = window + , R.videoWidget = videoWidget } - , R.ioRefs = R.IORefs { - R.isWindowFullScreenRef = isWindowFullScreenRef + , R.ioRefs = + R.IORefs + { R.isWindowFullScreenRef = isWindowFullScreenRef } - , R.playbin = playbin + , R.playbin = playbin } onWidgetRealizeCallbacks - = - void ( - GI.Gtk.onWidgetRealize videoWidget ( - windowRealizedHandler - application - onWidgetRealizeCallbacks - ) - ) >> - void ( - GI.Gtk.onWidgetWindowStateEvent window (widgetWindowStateEventHandler isWindowFullScreenRef) - ) >> - void ( - GI.Gtk.onWidgetDestroy window (windowDestroyHandler playbin) - ) >> - void ( - GI.GLib.timeoutAddSeconds GI.GLib.PRIORITY_DEFAULT 1 (hideOnScreenControls application) - ) + = do + void $ + GI.Gtk.onWidgetRealize videoWidget $ + windowRealizedHandler + application + onWidgetRealizeCallbacks + void $ + GI.Gtk.onWidgetWindowStateEvent window (widgetWindowStateEventHandler isWindowFullScreenRef) + void $ + GI.Gtk.onWidgetDestroy window (windowDestroyHandler playbin) + void $ + GI.GLib.timeoutAddSeconds GI.GLib.PRIORITY_DEFAULT 1 (adjustWindow application) windowRealizedHandler - :: R.Application - -> [R.Application -> IO ()] - -> GI.Gtk.WidgetRealizeCallback + :: R.Application + -> [R.Application -> IO ()] + -> GI.Gtk.WidgetRealizeCallback windowRealizedHandler - application@R.Application { - R.guiObjects = guiObjects@R.GuiObjects { - R.videoWidget = videoWidget - , R.seekScale = seekScale + application@R.Application + { R.guiObjects = + guiObjects@R.GuiObjects + { R.videoWidget = videoWidget + , R.seekScale = seekScale } } onWidgetRealizeCallbacks = do - let eventMask = enumToInt32 GI.Gdk.EventMaskAllEventsMask + let eventMask = [GI.Gdk.EventMaskAllEventsMask] GI.Gtk.widgetAddEvents videoWidget eventMask - GI.Gtk.widgetAddEvents seekScale eventMask - resetWindow guiObjects + GI.Gtk.widgetAddEvents seekScale eventMask + resetGuiObjects guiObjects mapM_ (\ f -> f application) onWidgetRealizeCallbacks widgetWindowStateEventHandler :: IORef Bool -> GI.Gdk.EventWindowState -> IO Bool widgetWindowStateEventHandler isWindowFullScreenRef eventWindowState = do windowStates <- GI.Gdk.getEventWindowStateNewWindowState eventWindowState - let isWindowFullScreen = Prelude.foldl (\ acc x -> - acc || GI.Gdk.WindowStateFullscreen == x - ) False windowStates + let isWindowFullScreen = + Prelude.foldl + (\ acc x -> acc || GI.Gdk.WindowStateFullscreen == x) + False + windowStates atomicWriteIORef isWindowFullScreenRef isWindowFullScreen return True @@ -90,53 +91,59 @@ _ <- GI.Gst.objectUnref playbin GI.Gtk.mainQuit -hideOnScreenControls :: R.Application -> IO Bool -hideOnScreenControls - application@R.Application { - R.guiObjects = R.GuiObjects { - R.window = window - , R.fileChooserButton = fileChooserButton - , R.bottomControlsGtkBox = bottomControlsGtkBox +adjustWindow :: R.Application -> IO Bool +adjustWindow + application@R.Application + { R.guiObjects = + R.GuiObjects + { R.window = window + , R.fileChooserButton = fileChooserButton + , R.bottomControlsGtkBox = bottomControlsGtkBox } - , R.ioRefs = R.IORefs { - R.videoInfoRef = videoInfoRef - , R.mouseMovedLastRef = mouseMovedLastRef + , R.ioRefs = + R.IORefs + { R.videoInfoRef = videoInfoRef + , R.mouseMovedLastRef = mouseMovedLastRef } - , R.playbin = playbin + , R.playbin = playbin } = do - videoInfoGathered <- readIORef videoInfoRef - let isVideo = R.isVideo videoInfoGathered - mouseMovedLast <- readIORef mouseMovedLastRef - timeNow <- fmap round getPOSIXTime + videoInfo <- readIORef videoInfoRef + mouseMovedLast <- readIORef mouseMovedLastRef + timeNow <- fmap round getPOSIXTime (_, playBinState, _) <- GI.Gst.elementGetState playbin (fromIntegral GI.Gst.MSECOND :: GHC.Word.Word64) let isPlaying = GI.Gst.StatePlaying == playBinState - let delta = timeNow - mouseMovedLast + let delta = timeNow - mouseMovedLast + let isVideo = R.isVideo videoInfo when (isPlaying && isVideo && delta >= hideOnScreenControlsInterval) $ do GI.Gtk.widgetHide fileChooserButton GI.Gtk.widgetHide bottomControlsGtkBox + styleContext <- GI.Gtk.widgetGetStyleContext bottomControlsGtkBox + GI.Gtk.styleContextRemoveClass styleContext "movie-monad-fade-in" setCursor window (Just "none") atomicWriteIORef mouseMovedLastRef timeNow - fillWindowWithVideo application + fillWindowWithVideo application return True fillWindowWithVideo :: R.Application -> IO () fillWindowWithVideo - R.Application { - R.guiObjects = guiObjects@R.GuiObjects { - R.window = window + R.Application + { R.guiObjects = + guiObjects@R.GuiObjects + { R.window = window } - , R.ioRefs = R.IORefs { - R.videoInfoRef = videoInfoRef - , R.isWindowFullScreenRef = isWindowFullScreenRef + , R.ioRefs = + R.IORefs + { R.videoInfoRef = videoInfoRef + , R.isWindowFullScreenRef = isWindowFullScreenRef } } = do - isWindowFullScreen <- readIORef isWindowFullScreenRef - unless isWindowFullScreen $ do - videoInfoGathered <- readIORef videoInfoRef - (width, _) <- GI.Gtk.windowGetSize window - maybeWindowSize <- calculateWindowSize guiObjects (fromIntegral width :: Int) videoInfoGathered + isWindowFullScreen <- readIORef isWindowFullScreenRef + videoInfo <- readIORef videoInfoRef + when (R.isVideo videoInfo && not isWindowFullScreen) $ do + (width, _) <- GI.Gtk.windowGetSize window + maybeWindowSize <- calculateWindowSize guiObjects (fromIntegral width :: Int) videoInfo when (isJust maybeWindowSize) $ do let (windowWidth, windowHeight) = fromMaybe (0, 0) maybeWindowSize setWindowSize guiObjects windowWidth windowHeight @@ -145,67 +152,68 @@ calculateWindowSize :: R.GuiObjects -> Int -> R.VideoInfo -> IO (Maybe (Int32, Int32)) calculateWindowSize _ _ R.VideoInfo { R.isVideo = False } = return Nothing calculateWindowSize - R.GuiObjects { - R.fileChooserButton = fileChooserButton - , R.bottomControlsGtkBox = bottomControlsGtkBox + R.GuiObjects + { R.fileChooserButton = fileChooserButton } desiredWidth - R.VideoInfo { R.videoWidth = videoWidth, R.videoHeight = videoHeight } + R.VideoInfo + { R.videoWidth = videoWidth + , R.videoHeight = videoHeight + } = do - fileChooserButtonIsVisible <- GI.Gtk.widgetGetVisible fileChooserButton - bottomControlsGtkBoxIsVisible <- GI.Gtk.widgetGetVisible bottomControlsGtkBox + fileChooserButtonIsVisible <- GI.Gtk.widgetGetVisible fileChooserButton fileChooserButtonHeight <- GI.Gtk.widgetGetAllocation fileChooserButton >>= GI.Gdk.getRectangleHeight - bottomControlsGtkBoxHeight <- GI.Gtk.widgetGetAllocation bottomControlsGtkBox >>= GI.Gdk.getRectangleHeight - let videoWidthDouble = fromIntegral videoWidth :: Double + let videoWidthDouble = fromIntegral videoWidth :: Double let videoHeightDouble = fromIntegral videoHeight :: Double - let ratio = if videoWidthDouble <= 0.0 then 0.0 else videoHeightDouble / videoWidthDouble + let ratio = + if videoWidthDouble <= 0.0 + then 0.0 + else videoHeightDouble / videoWidthDouble let desiredWidthDouble = fromIntegral desiredWidth :: Double - let topMargin = if fileChooserButtonIsVisible - then (fromIntegral fileChooserButtonHeight :: Double) - else 0.0 - let bottomMargin = if bottomControlsGtkBoxIsVisible - then (fromIntegral bottomControlsGtkBoxHeight :: Double) - else 0.0 + let topMargin = + if fileChooserButtonIsVisible + then (fromIntegral fileChooserButtonHeight :: Double) + else 0.0 + let bottomMargin = 0.0 let height = topMargin + (desiredWidthDouble * ratio) + bottomMargin - return (Just (fromIntegral desiredWidth:: Int32, round height :: Int32)) + return $ Just (fromIntegral desiredWidth:: Int32, round height :: Int32) setWindowSize :: R.GuiObjects -> Int32 -> Int32 -> IO () setWindowSize - R.GuiObjects { - R.window = window + R.GuiObjects + { R.window = window } width height = GI.Gtk.windowResize window width (if height <= 0 then 1 else height) -resetWindow :: R.GuiObjects -> IO () -resetWindow - guiObjects@R.GuiObjects { - R.window = window - , R.fileChooserButton = fileChooserButton - , R.videoWidget = videoWidget - , R.seekScale = seekScale - , R.playPauseButton = playPauseButton - , R.videoWidthSelectionComboBox = videoWidthSelectionComboBox - , R.subtitleSelectionComboBox = subtitleSelectionComboBox - , R.fullscreenButton = fullscreenButton - , R.playImage = playImage - , R.pauseImage = pauseImage - , R.bottomControlsGtkBox = bottomControlsGtkBox +setupWindowForPlayback :: R.GuiObjects -> Bool -> Bool -> Int32 -> Int32 -> IO () +setupWindowForPlayback + guiObjects@R.GuiObjects + { R.window = window + , R.videoWidget = videoWidget + , R.bottomControlsGtkBox = bottomControlsGtkBox + , R.seekScale = seekScale + , R.playPauseButton = playPauseButton + , R.repeatCheckButton = repeatCheckButton + , R.fullscreenButton = fullscreenButton + , R.playImage = playImage + , R.pauseImage = pauseImage } + isSeekable + isWindowFullScreen + windowWidth + windowHeight = do - videoWidthSelection <- getSelectedVideoWidth videoWidthSelectionComboBox - let width = fromIntegral videoWidthSelection :: Int32 - GI.Gtk.windowUnfullscreen window - GI.Gtk.widgetHide videoWidget - 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 - setCursor window Nothing - setPlayPauseButton playPauseButton playImage pauseImage False - setWindowSize guiObjects width 0 + GI.Gtk.widgetShow videoWidget + GI.Gtk.widgetShow playPauseButton + GI.Gtk.widgetShow repeatCheckButton + GI.Gtk.widgetShow fullscreenButton + GI.Gtk.setToggleButtonActive repeatCheckButton False + GI.Gtk.widgetSetSizeRequest window windowMinimumSize 100 + setPlayPauseButton playPauseButton playImage pauseImage True + unless isWindowFullScreen $ + setWindowSize guiObjects windowWidth windowHeight + hideOrShowSeekScale seekScale isSeekable diff --git a/src/c/gst-ffi.c b/src/c/gst-ffi.c --- a/src/c/gst-ffi.c +++ b/src/c/gst-ffi.c @@ -1,6 +1,6 @@ /* Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com */ diff --git a/src/c/gst-ffi.h b/src/c/gst-ffi.h --- a/src/c/gst-ffi.h +++ b/src/c/gst-ffi.h @@ -1,6 +1,6 @@ /* Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com */ diff --git a/src/data/about-icon.svg b/src/data/about-icon.svg new file mode 100644 --- /dev/null +++ b/src/data/about-icon.svg @@ -0,0 +1,267 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/data/fullscreen-icon.svg b/src/data/fullscreen-icon.svg new file mode 100644 --- /dev/null +++ b/src/data/fullscreen-icon.svg @@ -0,0 +1,147 @@ + + + + + + + + + + + + + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + diff --git a/src/data/gui.glade b/src/data/gui.glade --- a/src/data/gui.glade +++ b/src/data/gui.glade @@ -1,5 +1,5 @@ - + - + True False - gtk-dialog-question + about-icon.svg gtk-cancel @@ -60,30 +61,38 @@ True False - gtk-fullscreen + fullscreen-icon.svg + pause-image True False - gtk-media-pause + pause-icon.svg + play-image True False - gtk-media-play + play-icon.svg + + True + False + repeat-icon.svg + 100 1 10 + 448 True Movie Monad center 800 600 - movie-monad-icon.png + movie-monad-icon.svg center @@ -91,70 +100,69 @@ False vertical - + True - False + True + True + True + Load a Video + start True - True - vertical + half + right + True - + True - True - True - True - Open a video file - start - True - half - right - True + False - + True False - - - True - False - Open - fill - end - True - - - True - True - 0 - - - - - True - False - gtk-open - - - False - False - end - 2 - - + Open + fill + end + True + + True + True + 0 + + + + True + False + gtk-open + + + False + False + end + 2 + + - - False - False - 0 - + + + False + False + 1 + + + + + True + False + True + True True True - True + False True True vertical @@ -163,34 +171,32 @@ - True - True - 1 + -1 - + + bottom-controls-gtk-box + 400 True False + center end + 10 vertical bottom + seek-scale True - True - False - end + True + center 5 5 - True + 5 seek-scale-adjustment True 100 - 0 - -1 - False - left False @@ -199,22 +205,25 @@ - + + box-3 True False - end + center + 5 + 5 5 5 - True + 2 + play-pause-button True True True - Click to play - 5 - 5 + Click to Play play-image + none True @@ -224,16 +233,31 @@ + + repeat-check-button + True + True + False + Toggle Repeat On or Off + repeat-check-button-image + True + False + + + False + True + 1 + + + + volume-button True - True True False True False - 5 - 5 - half + none vertical 0.5 button @@ -242,7 +266,8 @@ audio-volume-low-symbolic audio-volume-medium-symbolic - + + volume-plus-button True True center @@ -251,7 +276,8 @@ - + + volume-minus-button True True center @@ -263,22 +289,21 @@ False False - 1 + 2 - + + window-width-selection-combo-box-text True - True - False - Set the window width - 5 - 5 + True + False + Set the Window Width 1 False 800 - 320 + 448 800 1024 1152 @@ -298,15 +323,15 @@ False False - 2 + 3 - - False - Select the subtitle language - 5 - 5 + + subtitle-selection-combo-box-text + True + False + Select the Subtitle Language -1 None @@ -315,58 +340,53 @@ False True - 3 + 4 - True - False + fullscreen-button + True False - Toggle on or off fullscreen - 5 - 5 + Toggle On or Off Fullscreen fullscreen-image - half + none True False True - 4 + 5 False - True False - 5 False False - 5 + 6 + about-button True - True - False + True + False False About Movie Monad - 5 - 5 about-image - half + none True False False end - 6 + 7 @@ -378,17 +398,15 @@ - False - False - end - 3 + True True True - 0 + end + 2 @@ -408,7 +426,7 @@ window window Movie Monad - 0.0.4.0 + 0.0.5.0 (C) 2017 David Lettier lettier.com https://github.com/lettier/movie-monad @@ -446,7 +464,7 @@ movie-monad-logo.svg custom - + False vertical 2 @@ -486,7 +504,7 @@ Thank you. True - + False vertical 2 @@ -514,7 +532,7 @@ dialog window - + False vertical 2 @@ -541,7 +559,7 @@ True True - Type in the path to a local file or URL + Type in a File Path or a URL False True gtk-edit diff --git a/src/data/movie-monad-icon.png b/src/data/movie-monad-icon.png deleted file mode 100644 Binary files a/src/data/movie-monad-icon.png and /dev/null differ diff --git a/src/data/movie-monad-icon.svg b/src/data/movie-monad-icon.svg new file mode 100644 --- /dev/null +++ b/src/data/movie-monad-icon.svg @@ -0,0 +1,267 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/data/pause-icon.svg b/src/data/pause-icon.svg new file mode 100644 --- /dev/null +++ b/src/data/pause-icon.svg @@ -0,0 +1,83 @@ + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + diff --git a/src/data/play-icon.svg b/src/data/play-icon.svg new file mode 100644 --- /dev/null +++ b/src/data/play-icon.svg @@ -0,0 +1,77 @@ + + + + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/src/data/repeat-icon.svg b/src/data/repeat-icon.svg new file mode 100644 --- /dev/null +++ b/src/data/repeat-icon.svg @@ -0,0 +1,193 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + diff --git a/src/data/style-3-18.css b/src/data/style-3-18.css new file mode 100644 --- /dev/null +++ b/src/data/style-3-18.css @@ -0,0 +1,40 @@ +/* + Movie Monad + (C) 2018 David Lettier + lettier.com +*/ + +#play-pause-button image, +#about-button image, +#volume-button image, +#repeat-check-button image, +#repeat-check-button check, +#fullscreen-button image, +#play-pause-button image:hover, +#about-button image:hover, +#volume-button image:hover, +#repeat-check-button image:hover, +#fullscreen-button image:hover { + text-decoration-color: transparent; +} + +#repeat-check-button:checked { + background-color: rgba(255, 255, 255, 0.1); +} + +combobox button, +GtkComboBox .button { + text-decoration: none; +} + +menuitem, +GtkMenuItem, +menuitem:hover, +GtkMenuItem:hover { + text-decoration: none; +} + +menuitem cellview, +GtkMenuItem GtkCellView { + text-decoration-color: transparent; +} diff --git a/src/data/style-3-20.css b/src/data/style-3-20.css new file mode 100644 --- /dev/null +++ b/src/data/style-3-20.css @@ -0,0 +1,24 @@ +/* + Movie Monad + (C) 2018 David Lettier + lettier.com +*/ + +slider { + min-width: 15px; + min-height: 15px; +} + +#play-pause-button image, +#about-button image, +#volume-button image, +#repeat-check-button image, +#repeat-check-button check, +#fullscreen-button image, +#play-pause-button image:hover, +#about-button image:hover, +#volume-button image:hover, +#repeat-check-button image:hover, +#fullscreen-button image:hover { + -gtk-icon-shadow: none; +} diff --git a/src/data/style.css b/src/data/style.css new file mode 100644 --- /dev/null +++ b/src/data/style.css @@ -0,0 +1,299 @@ +/* + Movie Monad + (C) 2018 David Lettier + lettier.com +*/ + +@define-color _movie_monad_black rgba(10, 10, 10, 0.8); +@define-color _movie_monad_white_nine rgba(255, 255, 255, 0.9); +@define-color _movie_monad_white_five rgba(255, 255, 255, 0.5); +@define-color _movie_monad_blue rgba(87, 172, 227, 1.0); +@define-color _movie_monad_pink rgba(224, 67, 127, 1.0); + +@keyframes movie_monad_fade_in { + from { opacity: 0; } + to { opacity: 1; } +} + +#bottom-controls-gtk-box { + background-color: @_movie_monad_black; + border-color: @_movie_monad_black; + border-width: 1px; + border-radius: 5px; + padding: 5px; + padding-left: 10px; + padding-right: 10px; + margin-bottom: 0px; +} + +#play-pause-button, +#about-button, +#volume-button, +#volume-plus-button, +#volume-minus-button, +#repeat-check-button, +#fullscreen-button, +#window-width-selection-combo-box-text button.combo, +#subtitle-selection-combo-box-text button.combo, +#bottom-controls-gtk-box .button { + background-color: transparent; + border-color: transparent; + border-width: 0px; + border-radius: 5px; + margin: 5px; + background-image: none; + color: white; + box-shadow: none; + text-shadow: none; + border-image-source: none; +} + +GtkBox#bottom-controls-gtk-box .button { + padding-left: 7.5px; + padding-right: 7.5px; +} + +#play-pause-button image, +#about-button image, +#volume-button image, +#repeat-check-button image, +#repeat-check-button check, +#fullscreen-button image, +#play-pause-button image:hover, +#about-button image:hover, +#volume-button image:hover, +#repeat-check-button image:hover, +#fullscreen-button image:hover { + text-shadow: none; + border-color: transparent; + border-top-color: transparent; + border-bottom-color: transparent; + border-left-color: transparent; + border-right-color: transparent; + background-image: none; +} + +#play-pause-button:focus, +#about-button:focus, +#volume-button:focus, +#volume-plus-button:focus, +#volume-minus-button:focus, +#repeat-check-button:focus, +#fullscreen-button:focus, +#window-width-selection-combo-box-text button.combo:focus, +#subtitle-selection-combo-box-text button.combo:focus, +#play-pause-button image:focus, +#about-button image:focus, +#volume-button image:focus, +#repeat-check-button image:focus, +#repeat-check-button check:focus, +#fullscreen-button image:focus, +#play-pause-button image:focus, +#about-button image:focus, +#volume-button image:focus, +#repeat-check-button image:focus, +#fullscreen-button image:focus { + outline-color: transparent; + outline-offset: 0px; + outline-width: 0px; + outline-style: none; + outline: none; +} + +#play-pause-button:hover, +#about-button:hover, +#volume-button:hover, +#volume-plus-button:hover, +#volume-minus-button:hover, +#repeat-check-button:hover, +#repeat-check-button:active, +#fullscreen-button:hover, +#window-width-selection-combo-box-text button.combo:hover, +#subtitle-selection-combo-box-text button.combo:hover, +#window-width-selection-combo-box-text .button:hover { + background-color: rgba(255, 255, 255, 0.1); +} + +GtkScale { + background-color: @_movie_monad_black; + background-image: none; + border-color: black; + border: none; + color: @_movie_monad_white_five; +} + +GtkScale.horizontal { + margin-left: 10px; + margin-right: 10px; +} + +scale slider { + background-color: @_movie_monad_white_nine; + border-width: 0px; + border-style: none; + border-image-source: none; + background-image: none; + box-shadow: none; + border-radius: 100%; + margin: -5px; + padding: 0px; +} + +#seek-scale .slider, +GtkPopover .slider { + background-color: @_movie_monad_white_nine; + margin: -3px; +} + +GtkBox#bottom-controls-gtk-box .trough { + margin-right: 10px; + margin-left: 10px; +} + +scale trough, +GtkScale .trough { + background-color: rgba(0, 0, 0, 0.1); + border-width: 0px; + border-style: none; + border-image-source: none; + border-image: none; + border: none; + background-image: none; +} + +scale trough:focus, +GtkScale .trough { + outline-color: transparent; + outline-offset: 0px; + outline-width: 0px; + outline-style: none; + outline: none; +} + +scale fill { + background-color: rgba(0, 0, 0, 0.1); + border-width: 0px; + border-style: none; + border-image-source: none; + border: none; +} + +scale highlight, +.highlight { + background-color: @_movie_monad_blue; + background-image: none; + border-width: 0px; + border-style: none; + border-image-source: none; + border: none; +} + +scale value { + color: @_movie_monad_white_five; + margin-bottom: 5px; +} + +scale#seek-scale highlight, +GtkScale#seek-scale .highlight { + background-image: linear-gradient(to right, @_movie_monad_blue 0%, @_movie_monad_pink 100%); +} + +popover highlight, +GtkPopover .highlight { + background-image: linear-gradient(to top, @_movie_monad_blue 0%, @_movie_monad_pink 100%); +} + +combobox button, +GtkComboBox .button { + color: white; + text-shadow: none; +} + +.scale-popup, +combobox menu, +GtkComboBox .menu { + background-color: @_movie_monad_black; + border-width: 0px; + border-style: none; + border-image-source: none; + border: none; + box-shadow: none; +} + +combobox window, +combobox decoration, +combobox arrow, +GtkComboBox .arrow { + background-color: transparent; + border-width: 0px; + border-style: none; + border-image-source: none; + box-shadow: none; +} + +menuitem, +GtkMenuItem { + background-color: transparent; + color: white; + background-image: none; + text-shadow: none; + border-width: 0px; + border-style: none; + border-image-source: none; + border: none; + box-shadow: none; +} + +menuitem:hover, +GtkMenuItem:hover { + background-color: @_movie_monad_white_nine; + color: black; + background-image: none; + text-shadow: none; + border-width: 0px; + border-style: none; + border-image-source: none; + border: none; + box-shadow: none; +} + +menuitem:focus, +GtkMenuItem:focus { + outline-color: transparent; + outline-offset: 0px; + outline-width: 0px; + outline-style: none; + outline: none; +} + +menuitem cellview, +GtkMenuItem GtkCellView { + color: inherit; +} + +arrow, +GtkMenu .arrow { + text-shadow: none; + color: white; +} + +tooltip, +.tooltip { + color: white; + background-image: none; + background-color: @_movie_monad_black; + border-radius: 0px; + border-color: @_movie_monad_black; + border-width: 0px; + border-style: none; + border-image-source: none; + border: none; + box-shadow: none; +} + +.movie-monad-fade-in { + animation-name: movie_monad_fade_in; + animation-duration: 1s; + animation-timing-function: linear; + animation-iteration-count: 1; +} diff --git a/src/dev/Paths_movie_monad.hs b/src/dev/Paths_movie_monad.hs --- a/src/dev/Paths_movie_monad.hs +++ b/src/dev/Paths_movie_monad.hs @@ -1,6 +1,6 @@ {- Movie Monad - (C) 2017 David lettier + (C) 2017 David Lettier lettier.com -} diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,14 +1,34 @@ -flags: {} -extra-package-dbs: [] +resolver: lts-9.1 +compiler-check: match-exact packages: - '.' +extra-package-dbs: [] explicit-setup-deps: ! '*': true extra-deps: -- gi-gst-1.0.14 -- gi-gtk-3.0.18 +- haskell-gi-base-0.21.0 +- haskell-gi-overloading-1.0 +- haskell-gi-0.21.0 +- gi-gobject-2.0.16 +- gi-glib-2.0.16 +- gi-gdk-3.0.15 +- gi-gdkpixbuf-2.0.15 +- gi-gst-1.0.15 - gi-gstbase-1.0.15 -- gi-gstvideo-1.0.14 -- haskell-gi-base-0.20.8 -resolver: lts-9.1 -compiler-check: match-exact +- gi-gstvideo-1.0.15 +- gi-gtk-3.0.21 +flags: + gi-gobject: + enable-overloading: false + gi-glib: + enable-overloading: false + gi-gdk: + enable-overloading: false + gi-gdkpixbuf: + enable-overloading: false + gi-gst: + enable-overloading: false + gi-gstvideo: + enable-overloading: false + gi-gtk: + enable-overloading: false