{-|
Module      : Monomer.Widgets.Util.Keyboard
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Utility functions for widget keyboard handling.
-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Util.Keyboard (
  isShortCutControl,
  isKeyboardCopy,
  isKeyboardPaste,
  isKeyboardCut,
  isKeyboardUndo,
  isKeyboardRedo
) where

import Data.Maybe (fromMaybe)

import qualified Data.Map as M

import Monomer.Core
import Monomer.Event.Keyboard
import Monomer.Event.Types
import Monomer.Event.Util

-- | Checks if Ctrl/Cmd, depending on OS, is pressed.
isShortCutControl :: WidgetEnv s e -> KeyMod -> Bool
isShortCutControl :: WidgetEnv s e -> KeyMod -> Bool
isShortCutControl WidgetEnv s e
wenv KeyMod
mod = Bool
isControl Bool -> Bool -> Bool
|| Bool
isCommand where
  isControl :: Bool
isControl = Bool -> Bool
not (WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv) Bool -> Bool -> Bool
&& KeyMod -> Bool
isCtrlPressed KeyMod
mod
  isCommand :: Bool
isCommand = WidgetEnv s e -> Bool
forall s e. WidgetEnv s e -> Bool
isMacOS WidgetEnv s e
wenv Bool -> Bool -> Bool
&& KeyMod -> Bool
isGUIPressed KeyMod
mod

-- | Checks if a copy shortcut has been pressed.
isKeyboardCopy :: WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCopy :: WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCopy WidgetEnv s e
wenv SystemEvent
event = SystemEvent -> (KeyMod -> KeyCode -> KeyStatus -> Bool) -> Bool
checkKeyboard SystemEvent
event KeyMod -> KeyCode -> KeyStatus -> Bool
forall p. KeyMod -> KeyCode -> p -> Bool
testFn where
  testFn :: KeyMod -> KeyCode -> p -> Bool
testFn KeyMod
mod KeyCode
code p
motion = WidgetEnv s e -> KeyMod -> Bool
forall s e. WidgetEnv s e -> KeyMod -> Bool
isShortCutControl WidgetEnv s e
wenv KeyMod
mod Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyC KeyCode
code

-- | Checks if a paste shortcut has been pressed.
isKeyboardPaste :: WidgetEnv s e -> SystemEvent -> Bool
isKeyboardPaste :: WidgetEnv s e -> SystemEvent -> Bool
isKeyboardPaste WidgetEnv s e
wenv SystemEvent
event = SystemEvent -> (KeyMod -> KeyCode -> KeyStatus -> Bool) -> Bool
checkKeyboard SystemEvent
event KeyMod -> KeyCode -> KeyStatus -> Bool
forall p. KeyMod -> KeyCode -> p -> Bool
testFn where
  testFn :: KeyMod -> KeyCode -> p -> Bool
testFn KeyMod
mod KeyCode
code p
motion = WidgetEnv s e -> KeyMod -> Bool
forall s e. WidgetEnv s e -> KeyMod -> Bool
isShortCutControl WidgetEnv s e
wenv KeyMod
mod Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyV KeyCode
code

-- | Checks if a cut shortcut has been pressed.
isKeyboardCut :: WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCut :: WidgetEnv s e -> SystemEvent -> Bool
isKeyboardCut WidgetEnv s e
wenv SystemEvent
event = SystemEvent -> (KeyMod -> KeyCode -> KeyStatus -> Bool) -> Bool
checkKeyboard SystemEvent
event KeyMod -> KeyCode -> KeyStatus -> Bool
forall p. KeyMod -> KeyCode -> p -> Bool
testFn where
  testFn :: KeyMod -> KeyCode -> p -> Bool
testFn KeyMod
mod KeyCode
code p
motion = WidgetEnv s e -> KeyMod -> Bool
forall s e. WidgetEnv s e -> KeyMod -> Bool
isShortCutControl WidgetEnv s e
wenv KeyMod
mod Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyX KeyCode
code

-- | Checks if an undo shortcut has been pressed.
isKeyboardUndo :: WidgetEnv s e -> SystemEvent -> Bool
isKeyboardUndo :: WidgetEnv s e -> SystemEvent -> Bool
isKeyboardUndo WidgetEnv s e
wenv SystemEvent
event = SystemEvent -> (KeyMod -> KeyCode -> KeyStatus -> Bool) -> Bool
checkKeyboard SystemEvent
event KeyMod -> KeyCode -> KeyStatus -> Bool
forall p. KeyMod -> KeyCode -> p -> Bool
testFn where
  testFn :: KeyMod -> KeyCode -> p -> Bool
testFn KeyMod
mod KeyCode
code p
motion = WidgetEnv s e -> KeyMod -> Bool
forall s e. WidgetEnv s e -> KeyMod -> Bool
isShortCutControl WidgetEnv s e
wenv KeyMod
mod
    Bool -> Bool -> Bool
&& Bool -> Bool
not (KeyMod -> Bool
_kmLeftShift KeyMod
mod)
    Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyZ KeyCode
code

-- | Checks if a redo shortcut has been pressed.
isKeyboardRedo :: WidgetEnv s e -> SystemEvent -> Bool
isKeyboardRedo :: WidgetEnv s e -> SystemEvent -> Bool
isKeyboardRedo WidgetEnv s e
wenv SystemEvent
event = SystemEvent -> (KeyMod -> KeyCode -> KeyStatus -> Bool) -> Bool
checkKeyboard SystemEvent
event KeyMod -> KeyCode -> KeyStatus -> Bool
forall p. KeyMod -> KeyCode -> p -> Bool
testFn where
  testFn :: KeyMod -> KeyCode -> p -> Bool
testFn KeyMod
mod KeyCode
code p
motion = WidgetEnv s e -> KeyMod -> Bool
forall s e. WidgetEnv s e -> KeyMod -> Bool
isShortCutControl WidgetEnv s e
wenv KeyMod
mod
    Bool -> Bool -> Bool
&& KeyMod -> Bool
_kmLeftShift KeyMod
mod
    Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyZ KeyCode
code