movie-monad 0.0.2.0 → 0.0.3.0
raw patch · 14 files changed
+291/−123 lines, 14 filesdep ~basedep ~haskell-gi-base
Dependency ranges changed: base, haskell-gi-base
Files
- CHANGELOG.md +31/−1
- README.md +60/−20
- makefile +51/−0
- movie-monad.cabal +6/−4
- src/Constants.hs +3/−0
- src/FileChooser.hs +3/−5
- src/Keyboard.hs +18/−3
- src/Main.hs +1/−1
- src/Mouse.hs +17/−10
- src/Seek.hs +0/−5
- src/VideoSizeSelector.hs +3/−6
- src/Window.hs +78/−64
- src/data/gui.glade +6/−4
- stack.yaml +14/−0
CHANGELOG.md view
@@ -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
README.md view
@@ -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 -+### Linux -+ -+ +### Mac+++++ ## 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
+ makefile view
@@ -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)
movie-monad.cabal view
@@ -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.*
src/Constants.hs view
@@ -15,3 +15,6 @@ invalidVideoWidgetName :: Data.Text.Text invalidVideoWidgetName = "invalid-video-widget"++keyboardShortcutSeekAdvanceBy :: Double+keyboardShortcutSeekAdvanceBy = 10.0
src/FileChooser.hs view
@@ -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 ::
src/Keyboard.hs view
@@ -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
src/Main.hs view
@@ -156,7 +156,7 @@ addSeekHandlers application addVideoSizeSelectorHandler application addFullscreenButtonReleaseHandler application- addWindowMouseMoveHandlers application+ addMouseMoveHandlers application [fillWindowWithVideo] addAboutHandler application addKeyboardEventHandler application addErrorMessageDialogHandler application
src/Mouse.hs view
@@ -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 ()
src/Seek.hs view
@@ -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 ->
src/VideoSizeSelector.hs view
@@ -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
src/Window.hs view
@@ -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
src/data/gui.glade view
@@ -33,7 +33,7 @@ <requires lib="gtk+" version="3.10"/> <!-- interface-license-type bsd3c --> <!-- interface-name Movie Monad -->- <!-- interface-description A desktop video player built with Haskell that uses GStreamer and GTK+. -->+ <!-- interface-description A free and simple to use video player built with Haskell. --> <!-- interface-copyright 2017 David Lettier --> <!-- interface-authors David Lettier --> <object class="GtkImage" id="about-image">@@ -81,6 +81,8 @@ <property name="can_focus">True</property> <property name="title" translatable="yes">Movie Monad</property> <property name="window_position">center</property>+ <property name="default_width">800</property>+ <property name="default_height">600</property> <property name="icon">movie-monad-icon.png</property> <property name="gravity">center</property> <child>@@ -97,7 +99,6 @@ <property name="orientation">vertical</property> <child> <object class="GtkButton" id="file-chooser-button">- <property name="width_request">800</property> <property name="visible">True</property> <property name="app_paintable">True</property> <property name="can_focus">True</property>@@ -270,7 +271,7 @@ <property name="visible">True</property> <property name="app_paintable">True</property> <property name="can_focus">False</property>- <property name="tooltip_text" translatable="yes">Set the video width</property>+ <property name="tooltip_text" translatable="yes">Set the window width</property> <property name="margin_left">5</property> <property name="margin_right">5</property> <property name="active">1</property>@@ -382,6 +383,7 @@ <object class="GtkAboutDialog" id="about-dialog"> <property name="can_focus">False</property> <property name="title" translatable="yes">Movie Monad - About</property>+ <property name="resizable">False</property> <property name="window_position">center</property> <property name="icon_name">dialog-information</property> <property name="type_hint">dialog</property>@@ -389,7 +391,7 @@ <property name="transient_for">window</property> <property name="attached_to">window</property> <property name="program_name">Movie Monad</property>- <property name="version">0.0.2.0</property>+ <property name="version">0.0.3.0</property> <property name="copyright" translatable="yes">(C) 2017 David Lettier lettier.com</property> <property name="website">https://github.com/lettier/movie-monad</property>
+ stack.yaml view
@@ -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