movie-monad-0.0.2.0: src/Keyboard.hs

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

module Keyboard where

import Control.Monad
import Data.IORef
import qualified GI.Gdk
import qualified GI.Gtk

import qualified Records as R
import Mouse
import PlayPause
import Fullscreen

addKeyboardEventHandler :: R.Application -> IO ()
addKeyboardEventHandler
  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
  application@R.Application {
        R.guiObjects = R.GuiObjects {
              R.volumeButton = volumeButton
          }
      , 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
  eventButton <- GI.Gdk.newZeroEventButton
  -- 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
    GI.Gtk.scaleButtonSetValue volumeButton newVolume
  -- Play/Pause Toggle
  when ((keyValue == GI.Gdk.KEY_space || keyValue == GI.Gdk.KEY_AudioPlay) && isVideo) $
    void $ playPauseButtonClickHandler application eventButton
  -- 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
    GI.Gtk.scaleButtonSetValue volumeButton newVolume
  -- Volume Down
  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
  -- Show Controls
  when (keyValue == GI.Gdk.KEY_c) $ do
    eventMotion <- GI.Gdk.newZeroEventMotion
    void $ windowMouseMoveHandler application eventMotion
  -- Fullscreen Toggle
  when (keyValue == GI.Gdk.KEY_f && isVideo) $ do
    eventMotion <- GI.Gdk.newZeroEventMotion
    void $ windowMouseMoveHandler application eventMotion
    void $ fullscreenButtonReleaseHandler application eventButton
  return True