diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,36 @@ # [Movie Monad](https://github.com/lettier/movie-monad) -## Changelog +## CHANGELOG + +### 0.0.3.0 + +#### Added + +- PKGBUILD for Arch Linux +- AppImage specific desktop file +- Linux screenshot +- Ubuntu snapcraft.yaml +- Seek left and right keyboard shortcuts + +#### Changed + +- Cabal file + - Added stack.yaml + - Added makefile + - Changed base to use ghc-8.0.1 or ghc-8.0.2 +- README +- makefile + - Ensure cabal binary is stack version + - Force reinstalls for cabal install +- Dependencies +- Allow the window to be freely resized no matter the current width selection +- Adjusts the window height so that the video can fill the width of the window + +#### Removed + +- Version from mac screenshot + +------------------------------------------------------------------------------- ### 0.0.2.0 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,28 +2,35 @@ # Movie Monad -A desktop video player built with Haskell that uses GStreamer and GTK+. +A free and simple to use video player built with Haskell. ## Screenshots -![GUI showing Sintel from the Blender Foundation](https://i.imgur.com/UBNYbER.jpg) +### Linux -![GUI showing Big Buck Bunny from the Blender Foundation](https://i.imgur.com/Tgmk7SW.png) +![GUI showing "Caminandes 3: LLamigos" from the Blender Foundation](https://i.imgur.com/aYf6XOB.png) -![GUI showing the About window as seen on the Mac](https://i.imgur.com/hiix2Wm.png) +![GUI showing "Sintel" from the Blender Foundation](https://i.imgur.com/UBNYbER.jpg) +### Mac + +![GUI showing "Big Buck Bunny" from the Blender Foundation](https://i.imgur.com/Tgmk7SW.png) + +![GUI showing the About window as seen on the Mac](https://i.imgur.com/pTJLQdM.png) + ## Features -* Local or remote video file playback +* Local or Remote Video Playback * `file://` * `http://` * `https://` -* Window size selection -* Fullscreen mode +* Window Size Quick Select +* Responsive Window Resizing +* Fullscreen Mode * Seek -* Play and pause +* Play and Pause * Volume -* Command line play +* Command-line Play * `movie-monad ./path/to/video/file.mp4` * `movie-monad http://www.domain.tld/path/to/video/file.mp4` @@ -42,6 +49,10 @@ * Volume Down * `ArrowDown` * `AudioLowerVolume` +* Seek Left + * `ArrowLeft` +* Seek Right + * `ArrowRight` * Play/Pause * `Space` * `AudioPlay` @@ -54,9 +65,11 @@ * [Ubuntu 16.04](https://www.ubuntu.com/desktop) * [Ubuntu 14.04](https://www.ubuntu.com/desktop) * [Linux Mint 18.2](https://linuxmint.com/) -* [Manjaro 17.04](https://manjaro.org/) * [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 @@ -69,7 +82,7 @@ * [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](https://gstreamer.freedesktop.org/modules/gst-plugins-bad.html) + * [GStreamer Bad Plug-ins >= 1.8](https://gstreamer.freedesktop.org/modules/gst-plugins-bad.html) ### Build @@ -82,22 +95,49 @@ #### AppImage +##### Download & Run + ```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 -# * equals the current version -# Download the latest AppImage movie-monad-*-x86_64.AppImage -wget https://github.com/lettier/movie-monad/releases/download/*/movie-monad-*-x86_64.AppImage -chmod a+x movie-monad-*-x86_64.AppImage -./movie-monad-*-x86_64.AppImage -# If you would like to install the AppImage, you can run the following +# Download the latest AppImage movie-monad-0.0.3.0-x86_64.AppImage +wget https://github.com/lettier/movie-monad/releases/download/0.0.3.0/movie-monad-0.0.3.0-x86_64.AppImage +chmod a+x movie-monad-0.0.3.0-x86_64.AppImage +./movie-monad-0.0.3.0-x86_64.AppImage +``` + +##### Install + +```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 +``` + +#### [Arch/Manjaro/Antergos](https://aur.archlinux.org/packages/movie-monad/) + +```bash cd -wget "https://raw.githubusercontent.com/lettier/movie-monad/master/packaging/linux/movie-monad-install.sh" -O "movie-monad-install.sh" -chmod +x "movie-monad-install.sh" -./movie-monad-install.sh +# Install Git (https://git-scm.com/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 +git clone https://aur.archlinux.org/movie-monad.git +cd movie-monad +makepkg -sic +cd +rm -rf movie-monad-tmp +movie-monad ``` ### Mac diff --git a/makefile b/makefile new file mode 100644 --- /dev/null +++ b/makefile @@ -0,0 +1,51 @@ +# (C) 2017 David Lettier +# lettier.com + +.RECIPEPREFIX != ps + +STACK=stack --allow-different-user +STACK_SNAPSHOT_INSTALL_ROOT=`$(STACK) path --snapshot-install-root` +STACK_PATH_LOCAL_BIN=`$(STACK) path --local-bin` +STACK_GHC_EXE=`$(STACK) path --compiler-exe` +STACK_GHC_BIN=`$(STACK) path --compiler-bin` +STACK_PATHS=$(STACK_PATH_LOCAL_BIN):$(STACK_GHC_BIN):$(STACK_SNAPSHOT_INSTALL_ROOT) +CABAL=env PATH=$(PATH):$(STACK_PATHS) $(STACK_SNAPSHOT_INSTALL_ROOT)/bin/cabal + +export PATH := $(PATH):$(STACK_PATH_LOCAL_BIN) + +all: setup build + +setup: + $(STACK) setup && \ + $(STACK) update && \ + $(STACK) build alex && \ + $(STACK) build happy + +build: setup + $(STACK) build + +install: build + $(STACK) install + +run: install + $(STACK) exec -- movie-monad + +build_sdist: + $(STACK) sdist + +cabal_update: setup + $(STACK) build cabal-install && \ + $(CABAL) update + +cabal_clean: cabal_update + $(CABAL) clean && \ + $(CABAL) sandbox init && \ + $(CABAL) sandbox delete && \ + $(CABAL) sandbox init + +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) diff --git a/movie-monad.cabal b/movie-monad.cabal --- a/movie-monad.cabal +++ b/movie-monad.cabal @@ -1,7 +1,7 @@ name: movie-monad -version: 0.0.2.0 +version: 0.0.3.0 synopsis: Plays videos using GStreamer and GTK+. -description: Desktop video player that uses GStreamer and GTK+. +description: A free and simple to use video player built with Haskell. homepage: https://github.com/lettier/movie-monad license: BSD3 license-file: LICENSE @@ -17,6 +17,8 @@ extra-source-files: README.md , LICENSE , CHANGELOG.md + , makefile + , stack.yaml , ./src/dev/Paths_movie_monad.hs , ./src/data/gui.glade , ./src/data/movie-monad-logo.svg @@ -51,7 +53,7 @@ executable movie-monad main-is: Main.hs default-language: Haskell2010 - build-depends: base >= 4.7 && < 5 + build-depends: base == 4.9.* , filepath == 1.4.* , system-fileio == 0.3.* , system-filepath == 0.4.* @@ -60,7 +62,7 @@ , process == 1.4.* , MissingH == 1.4.* , network-uri == 2.6.* - , haskell-gi-base == 0.20.4 + , haskell-gi-base == 0.20.8 , gi-gobject == 2.0.* , gi-glib == 2.0.* , gi-gdk == 3.0.* diff --git a/src/Constants.hs b/src/Constants.hs --- a/src/Constants.hs +++ b/src/Constants.hs @@ -15,3 +15,6 @@ invalidVideoWidgetName :: Data.Text.Text invalidVideoWidgetName = "invalid-video-widget" + +keyboardShortcutSeekAdvanceBy :: Double +keyboardShortcutSeekAdvanceBy = 10.0 diff --git a/src/FileChooser.hs b/src/FileChooser.hs --- a/src/FileChooser.hs +++ b/src/FileChooser.hs @@ -50,9 +50,7 @@ fileChooserDialogResponseHandler R.Application { R.guiObjects = guiObjects@R.GuiObjects { - R.window = window - , R.fileChooserButton = fileChooserButton - , R.videoWidget = videoWidget + R.videoWidget = videoWidget , R.seekScale = seekScale , R.playPauseButton = playPauseButton , R.videoWidthSelectionComboBox = videoWidthSelectionComboBox @@ -110,7 +108,7 @@ videoWidthSelection = do retrievedVideoInfo <- getVideoInfo videoInfoRef filePathNameStr - maybeWindowSize <- calculateWindowSize videoWidthSelection retrievedVideoInfo + maybeWindowSize <- calculateWindowSize guiObjects videoWidthSelection retrievedVideoInfo GI.Gtk.widgetSetSensitive seekScale True if R.isSeekable retrievedVideoInfo then GI.Gtk.widgetShow seekScale @@ -135,7 +133,7 @@ GI.Gtk.widgetShow fullscreenButton setPlayPauseButton playPauseButton playImage pauseImage True unless isWindowFullScreen $ - setWindowSize width height fileChooserButton videoWidget window + setWindowSize guiObjects width height void $ GI.Gst.elementSetState playbin GI.Gst.StatePlaying fileChooserButtonClickHandler :: diff --git a/src/Keyboard.hs b/src/Keyboard.hs --- a/src/Keyboard.hs +++ b/src/Keyboard.hs @@ -7,14 +7,17 @@ module Keyboard where import Control.Monad +import Data.Fixed import Data.IORef import qualified GI.Gdk import qualified GI.Gtk import qualified Records as R +import Window import Mouse import PlayPause import Fullscreen +import Constants addKeyboardEventHandler :: R.Application -> IO () addKeyboardEventHandler @@ -34,9 +37,10 @@ application@R.Application { R.guiObjects = R.GuiObjects { R.volumeButton = volumeButton + , R.seekScale = seekScale } , R.ioRefs = R.IORefs { - R.videoInfoRef = videoInfoRef + R.videoInfoRef = videoInfoRef } } eventKey @@ -47,6 +51,7 @@ oldVolume <- GI.Gtk.scaleButtonGetValue volumeButton keyValue <- GI.Gdk.getEventKeyKeyval eventKey eventButton <- GI.Gdk.newZeroEventButton + rangeValue <- GI.Gtk.rangeGetValue seekScale -- 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 @@ -62,13 +67,23 @@ when (keyValue == GI.Gdk.KEY_Down || keyValue == GI.Gdk.KEY_AudioLowerVolume) $ do let newVolume = if oldVolume <= 0.0 then 0.0 else oldVolume - volumeDelta GI.Gtk.scaleButtonSetValue volumeButton newVolume + -- Seek left + when (keyValue == GI.Gdk.KEY_Left) $ do + void $ GI.Gtk.rangeSetValue + seekScale + ((rangeValue - keyboardShortcutSeekAdvanceBy) `Data.Fixed.mod'` 100.0) + -- Seek right + when (keyValue == GI.Gdk.KEY_Right) $ do + void $ GI.Gtk.rangeSetValue + seekScale + ((rangeValue + keyboardShortcutSeekAdvanceBy) `Data.Fixed.mod'` 100.0) -- Show Controls when (keyValue == GI.Gdk.KEY_c) $ do eventMotion <- GI.Gdk.newZeroEventMotion - void $ windowMouseMoveHandler application eventMotion + void $ mouseMoveHandler application [fillWindowWithVideo] eventMotion -- Fullscreen Toggle when (keyValue == GI.Gdk.KEY_f && isVideo) $ do eventMotion <- GI.Gdk.newZeroEventMotion - void $ windowMouseMoveHandler application eventMotion + void $ mouseMoveHandler application [fillWindowWithVideo] eventMotion void $ fullscreenButtonReleaseHandler application eventButton return True diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -156,7 +156,7 @@ addSeekHandlers application addVideoSizeSelectorHandler application addFullscreenButtonReleaseHandler application - addWindowMouseMoveHandlers application + addMouseMoveHandlers application [fillWindowWithVideo] addAboutHandler application addKeyboardEventHandler application addErrorMessageDialogHandler application diff --git a/src/Mouse.hs b/src/Mouse.hs --- a/src/Mouse.hs +++ b/src/Mouse.hs @@ -16,24 +16,29 @@ import qualified Records as R -addWindowMouseMoveHandlers :: R.Application -> IO () -addWindowMouseMoveHandlers +addMouseMoveHandlers :: R.Application -> [R.Application -> IO ()] -> IO () +addMouseMoveHandlers application@R.Application { R.guiObjects = R.GuiObjects { R.videoWidget = videoWidget , R.seekScale = seekScale } } + onMouseMoveCallbacks = - void (GI.Gtk.onWidgetMotionNotifyEvent videoWidget (windowMouseMoveHandler application)) >> - void (GI.Gtk.onWidgetMotionNotifyEvent seekScale (windowMouseMoveHandler application)) + void (GI.Gtk.onWidgetMotionNotifyEvent videoWidget mouseMoveHandler') + >> void (GI.Gtk.onWidgetMotionNotifyEvent seekScale mouseMoveHandler') + where + mouseMoveHandler' :: GI.Gdk.EventMotion -> IO Bool + mouseMoveHandler' = mouseMoveHandler application onMouseMoveCallbacks -windowMouseMoveHandler :: - R.Application -> - GI.Gdk.EventMotion -> - IO Bool -windowMouseMoveHandler - R.Application { +mouseMoveHandler + :: R.Application + -> [R.Application -> IO ()] + -> GI.Gdk.EventMotion + -> IO Bool +mouseMoveHandler + application@R.Application { R.guiObjects = R.GuiObjects { R.window = window , R.fileChooserButton = fileChooserButton @@ -44,6 +49,7 @@ , R.mouseMovedLastRef = mouseMovedLastRef } } + onMouseMoveCallbacks _ = do isWindowFullScreen <- readIORef isWindowFullScreenRef @@ -52,6 +58,7 @@ setCursor window Nothing timeNow <- getPOSIXTime atomicWriteIORef mouseMovedLastRef (round timeNow) + mapM_ (\ f -> f application) onMouseMoveCallbacks return False setCursor :: GI.Gtk.Window -> Maybe Text -> IO () diff --git a/src/Seek.hs b/src/Seek.hs --- a/src/Seek.hs +++ b/src/Seek.hs @@ -9,7 +9,6 @@ import Control.Monad import Data.IORef import Data.Int -import Data.Time.Clock.POSIX import Data.GI.Base.Signals import GI.GLib import GI.GObject @@ -44,10 +43,6 @@ seekScaleHandlerId ) ) - -seekRequestLastDeltaThreshold :: R.VideoInfo -> POSIXTime -seekRequestLastDeltaThreshold R.VideoInfo { R.isLocalFile = True } = 0.0 -seekRequestLastDeltaThreshold R.VideoInfo { R.isLocalFile = False } = 0.0 onRangeValueChanged :: GI.Gst.Element -> diff --git a/src/VideoSizeSelector.hs b/src/VideoSizeSelector.hs --- a/src/VideoSizeSelector.hs +++ b/src/VideoSizeSelector.hs @@ -34,10 +34,7 @@ videoSizeSelectionHandler R.Application { R.guiObjects = guiObjects@R.GuiObjects { - R.window = window - , R.fileChooserButton = fileChooserButton - , R.videoWidget = videoWidget - , R.videoWidthSelectionComboBox = videoWidthSelectionComboBox + R.videoWidthSelectionComboBox = videoWidthSelectionComboBox , R.fileChooserEntry = fileChooserEntry } , R.ioRefs = R.IORefs { @@ -48,7 +45,7 @@ filePathName <- Data.Text.unpack <$> GI.Gtk.entryGetText fileChooserEntry videoWidthSelection <- getSelectedVideoWidth videoWidthSelectionComboBox retrievedVideoInfo <- getVideoInfo videoInfoRef filePathName - maybeWindowSize <- calculateWindowSize videoWidthSelection retrievedVideoInfo + maybeWindowSize <- calculateWindowSize guiObjects videoWidthSelection retrievedVideoInfo case maybeWindowSize of Nothing -> resetWindow guiObjects - Just (width, height) -> setWindowSize width height fileChooserButton videoWidget window + Just (width, height) -> setWindowSize guiObjects width height diff --git a/src/Window.hs b/src/Window.hs --- a/src/Window.hs +++ b/src/Window.hs @@ -10,6 +10,7 @@ import GHC.Word import Control.Monad +import Data.Maybe import Data.Int import Data.IORef import Data.Time.Clock.POSIX @@ -36,13 +37,13 @@ } , R.playbin = playbin } - functionsToRunOnWindowRealized + onWidgetRealizeCallbacks = void ( GI.Gtk.onWidgetRealize videoWidget ( windowRealizedHandler application - functionsToRunOnWindowRealized + onWidgetRealizeCallbacks ) ) >> void ( @@ -55,29 +56,26 @@ GI.GLib.timeoutAddSeconds GI.GLib.PRIORITY_DEFAULT 1 (hideOnScreenControls application) ) -windowRealizedHandler :: - R.Application -> - [R.Application -> IO ()] -> - GI.Gtk.WidgetRealizeCallback windowRealizedHandler + :: R.Application + -> [R.Application -> IO ()] + -> GI.Gtk.WidgetRealizeCallback +windowRealizedHandler application@R.Application { R.guiObjects = guiObjects@R.GuiObjects { R.videoWidget = videoWidget , R.seekScale = seekScale } } - functionsToRunOnWindowRealized + onWidgetRealizeCallbacks = do let eventMask = enumToInt32 GI.Gdk.EventMaskAllEventsMask GI.Gtk.widgetAddEvents videoWidget eventMask GI.Gtk.widgetAddEvents seekScale eventMask resetWindow guiObjects - mapM_ (\ f -> f application) functionsToRunOnWindowRealized + mapM_ (\ f -> f application) onWidgetRealizeCallbacks -widgetWindowStateEventHandler :: - IORef Bool -> - GI.Gdk.EventWindowState -> - IO Bool +widgetWindowStateEventHandler :: IORef Bool -> GI.Gdk.EventWindowState -> IO Bool widgetWindowStateEventHandler isWindowFullScreenRef eventWindowState = do windowStates <- GI.Gdk.getEventWindowStateNewWindowState eventWindowState let isWindowFullScreen = Prelude.foldl (\ acc x -> @@ -86,32 +84,29 @@ atomicWriteIORef isWindowFullScreenRef isWindowFullScreen return True -windowDestroyHandler :: - GI.Gst.Element -> - IO () +windowDestroyHandler :: GI.Gst.Element -> IO () windowDestroyHandler playbin = do _ <- GI.Gst.elementSetState playbin GI.Gst.StateNull _ <- GI.Gst.objectUnref playbin GI.Gtk.mainQuit -hideOnScreenControls :: - R.Application -> - IO Bool +hideOnScreenControls :: R.Application -> IO Bool hideOnScreenControls - R.Application { + 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.videoInfoRef = videoInfoRef + , R.mouseMovedLastRef = mouseMovedLastRef + } , R.playbin = playbin } = do - isVideo <- R.isVideo <$> readIORef videoInfoRef + videoInfoGathered <- readIORef videoInfoRef + let isVideo = R.isVideo videoInfoGathered mouseMovedLast <- readIORef mouseMovedLastRef timeNow <- fmap round getPOSIXTime (_, playBinState, _) <- GI.Gst.elementGetState playbin (fromIntegral GI.Gst.MSECOND :: GHC.Word.Word64) @@ -122,52 +117,71 @@ GI.Gtk.widgetHide bottomControlsGtkBox setCursor window (Just "none") atomicWriteIORef mouseMovedLastRef timeNow + fillWindowWithVideo application return True -calculateWindowSize :: Int -> R.VideoInfo -> IO (Maybe (Int32, Int32)) -calculateWindowSize videoWidthSelection retrievedVideoInfo = - widthHeightToDouble retrievedVideoInfo >>= - ratio >>= - windowSize - where - widthHeightToDouble :: R.VideoInfo -> IO (Maybe Double, Maybe Double) - widthHeightToDouble R.VideoInfo { R.isVideo = False } = return (Nothing, Nothing) - widthHeightToDouble R.VideoInfo { R.videoWidth = w, R.videoHeight = h } = - return (Just $ fromIntegral w :: Maybe Double, Just $ fromIntegral h :: Maybe Double) - ratio :: (Maybe Double, Maybe Double) -> IO (Maybe Double) - ratio (Just width, Just height) = - if width <= 0.0 then return Nothing else return (Just (height / width)) - ratio _ = return Nothing - windowSize :: Maybe Double -> IO (Maybe (Int32, Int32)) - windowSize Nothing = return Nothing - windowSize (Just ratio') = - return ( - Just ( - fromIntegral videoWidthSelection :: Int32 - , round ((fromIntegral videoWidthSelection :: Double) * ratio') :: Int32 - ) - ) +fillWindowWithVideo :: R.Application -> IO () +fillWindowWithVideo + R.Application { + R.guiObjects = guiObjects@R.GuiObjects { + R.window = window + } + , R.ioRefs = R.IORefs { + R.videoInfoRef = videoInfoRef + , R.isWindowFullScreenRef = isWindowFullScreenRef + } + } + = do + isWindowFullScreen <- readIORef isWindowFullScreenRef + when (not isWindowFullScreen) $ do + videoInfoGathered <- readIORef videoInfoRef + (width, _) <- GI.Gtk.windowGetSize window + maybeWindowSize <- calculateWindowSize guiObjects (fromIntegral width :: Int) videoInfoGathered + when (isJust maybeWindowSize) $ do + let (windowWidth, windowHeight) = fromMaybe (0, 0) maybeWindowSize + setWindowSize guiObjects windowWidth windowHeight + return () -setWindowSize :: - Int32 -> - Int32 -> - GI.Gtk.Button -> - GI.Gtk.Widget -> - GI.Gtk.Window -> - IO () -setWindowSize width height fileChooserButton videoWidget window = do - GI.Gtk.setWidgetWidthRequest fileChooserButton width - GI.Gtk.setWidgetWidthRequest videoWidget width - GI.Gtk.setWidgetHeightRequest videoWidget height - GI.Gtk.setWidgetWidthRequest window width - GI.Gtk.setWidgetHeightRequest window height +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 + } + desiredWidth + R.VideoInfo { R.videoWidth = videoWidth, R.videoHeight = videoHeight } + = do + fileChooserButtonIsVisible <- GI.Gtk.widgetGetVisible fileChooserButton + bottomControlsGtkBoxIsVisible <- GI.Gtk.widgetGetVisible bottomControlsGtkBox + fileChooserButtonHeight <- GI.Gtk.widgetGetAllocation fileChooserButton >>= GI.Gdk.getRectangleHeight + bottomControlsGtkBoxHeight <- GI.Gtk.widgetGetAllocation bottomControlsGtkBox >>= GI.Gdk.getRectangleHeight + let videoWidthDouble = fromIntegral videoWidth :: Double + let videoHeightDouble = fromIntegral videoHeight :: Double + 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 height = topMargin + (desiredWidthDouble * ratio) + bottomMargin + return (Just (fromIntegral desiredWidth:: Int32, round height :: Int32)) + +setWindowSize :: R.GuiObjects -> Int32 -> Int32 -> IO () +setWindowSize + R.GuiObjects { + R.window = window + } + width + height + = GI.Gtk.windowResize window width (if height <= 0 then 1 else height) -resetWindow :: - R.GuiObjects -> - IO () +resetWindow :: R.GuiObjects -> IO () resetWindow - R.GuiObjects { + guiObjects@R.GuiObjects { R.window = window , R.fileChooserButton = fileChooserButton , R.videoWidget = videoWidget @@ -192,4 +206,4 @@ GI.Gtk.widgetShow videoWidthSelectionComboBox setCursor window Nothing setPlayPauseButton playPauseButton playImage pauseImage False - setWindowSize width 0 fileChooserButton videoWidget window + setWindowSize guiObjects width 0 diff --git a/src/data/gui.glade b/src/data/gui.glade --- a/src/data/gui.glade +++ b/src/data/gui.glade @@ -33,7 +33,7 @@ - + @@ -81,6 +81,8 @@ True Movie Monad center + 800 + 600 movie-monad-icon.png center @@ -97,7 +99,6 @@ vertical - 800 True True True @@ -270,7 +271,7 @@ True True False - Set the video width + Set the window width 5 5 1 @@ -382,6 +383,7 @@ False Movie Monad - About + False center dialog-information dialog @@ -389,7 +391,7 @@ window window Movie Monad - 0.0.2.0 + 0.0.3.0 (C) 2017 David Lettier lettier.com https://github.com/lettier/movie-monad diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,14 @@ +flags: {} +extra-package-dbs: [] +packages: +- '.' +explicit-setup-deps: + ! '*': true +extra-deps: +- gi-gst-1.0.14 +- gi-gtk-3.0.18 +- gi-gstbase-1.0.15 +- gi-gstvideo-1.0.14 +- haskell-gi-base-0.20.8 +resolver: lts-9.1 +compiler-check: match-exact