movie-monad-0.0.3.0: src/Window.hs

{-
  Movie Monad
  (C) 2017 David lettier
  lettier.com
-}

{-# LANGUAGE OverloadedStrings #-}

module Window where

import GHC.Word
import Control.Monad
import Data.Maybe
import Data.Int
import Data.IORef
import Data.Time.Clock.POSIX
import GI.GLib
import qualified GI.Gdk
import qualified GI.Gtk
import qualified GI.Gst

import qualified Records as R
import Constants
import Mouse
import PlayPause
import Utils

addWindowHandlers :: R.Application -> [R.Application -> IO ()] -> IO ()
addWindowHandlers
  application@R.Application {
        R.guiObjects = R.GuiObjects {
              R.window = window
            , R.videoWidget = videoWidget
          }
      , R.ioRefs = R.IORefs {
              R.isWindowFullScreenRef = isWindowFullScreenRef
          }
      , 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)
    )

windowRealizedHandler
  :: R.Application
  -> [R.Application -> IO ()]
  -> GI.Gtk.WidgetRealizeCallback
windowRealizedHandler
  application@R.Application {
        R.guiObjects = guiObjects@R.GuiObjects {
              R.videoWidget = videoWidget
            , R.seekScale = seekScale
          }
    }
  onWidgetRealizeCallbacks
  = do
  let eventMask = enumToInt32 GI.Gdk.EventMaskAllEventsMask
  GI.Gtk.widgetAddEvents videoWidget eventMask
  GI.Gtk.widgetAddEvents seekScale eventMask
  resetWindow 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
  atomicWriteIORef isWindowFullScreenRef isWindowFullScreen
  return True

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
  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.playbin = playbin
    }
  = do
  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)
  let isPlaying = GI.Gst.StatePlaying == playBinState
  let delta = timeNow - mouseMovedLast
  when (isPlaying && isVideo && delta >= hideOnScreenControlsInterval) $ do
    GI.Gtk.widgetHide fileChooserButton
    GI.Gtk.widgetHide bottomControlsGtkBox
    setCursor window (Just "none")
    atomicWriteIORef mouseMovedLastRef timeNow
    fillWindowWithVideo application
  return True

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 ()

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
  guiObjects@R.GuiObjects {
        R.window = window
      , R.fileChooserButton = fileChooserButton
      , R.videoWidget = videoWidget
      , R.seekScale = seekScale
      , R.playPauseButton = playPauseButton
      , R.videoWidthSelectionComboBox = videoWidthSelectionComboBox
      , R.fullscreenButton = fullscreenButton
      , R.playImage = playImage
      , R.pauseImage = pauseImage
      , R.bottomControlsGtkBox = bottomControlsGtkBox
    }
  = 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.widgetShow fileChooserButton
  GI.Gtk.widgetShow bottomControlsGtkBox
  GI.Gtk.widgetShow videoWidthSelectionComboBox
  setCursor window Nothing
  setPlayPauseButton playPauseButton playImage pauseImage False
  setWindowSize guiObjects width 0