{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: WildBind.X11.Emulate.Example
-- Description: Example of WildBind.X11.Emulate
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- This is an example of using "WildBind.X11.Emulate". See the source.
--
-- @since 0.2.0.0
module WildBind.X11.Emulate.Example
       where

import WildBind
  ( Binding,
    wildBind, bindsF, on, as, run
  )
import WildBind.X11
  ( X11Front, XKeyEvent, ActiveWindow,
    withX11Front, makeFrontEnd,
    alt, ctrl, press, release
  )
import WildBind.X11.KeySym (xK_c, xK_w)
import WildBind.X11.Emulate (sendKey)

main :: IO ()
main :: IO ()
main = (X11Front XKeyEvent -> IO ()) -> IO ()
forall k a. (X11Front k -> IO a) -> IO a
withX11Front ((X11Front XKeyEvent -> IO ()) -> IO ())
-> (X11Front XKeyEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \X11Front XKeyEvent
x11 -> Binding ActiveWindow XKeyEvent
-> FrontEnd ActiveWindow XKeyEvent -> IO ()
forall i s. Ord i => Binding s i -> FrontEnd s i -> IO ()
wildBind (X11Front XKeyEvent -> Binding ActiveWindow XKeyEvent
myBinding X11Front XKeyEvent
x11) (X11Front XKeyEvent -> FrontEnd ActiveWindow XKeyEvent
forall k.
(XKeyInput k, Describable k, Ord k) =>
X11Front k -> FrontEnd ActiveWindow k
makeFrontEnd X11Front XKeyEvent
x11)

-- | To use emulation functions, you need to obtain an 'X11Front'
-- object by 'withX11Front', and call emulation functions on it.
--
-- 'bindsF' function is useful to send keyboard events to the current
-- 'ActiveWindow'.
myBinding :: X11Front XKeyEvent -> Binding ActiveWindow XKeyEvent
myBinding :: X11Front XKeyEvent -> Binding ActiveWindow XKeyEvent
myBinding X11Front XKeyEvent
x11 = Binder XKeyEvent (Action (ReaderT ActiveWindow IO) ()) ()
-> Binding ActiveWindow XKeyEvent
forall i fs r a bs.
Ord i =>
Binder i (Action (ReaderT fs IO) r) a -> Binding' bs fs i
bindsF (Binder XKeyEvent (Action (ReaderT ActiveWindow IO) ()) ()
 -> Binding ActiveWindow XKeyEvent)
-> Binder XKeyEvent (Action (ReaderT ActiveWindow IO) ()) ()
-> Binding ActiveWindow XKeyEvent
forall a b. (a -> b) -> a -> b
$ do
  XKeyEvent
-> Action (ReaderT ActiveWindow IO) ()
-> Binder XKeyEvent (Action (ReaderT ActiveWindow IO) ()) ()
forall i v. i -> v -> Binder i v ()
on (KeySym -> XKeyEvent
forall k. ToXKeyEvent k => k -> XKeyEvent
alt KeySym
xK_w) `as` ActionDescription
"Copy" (Action (ReaderT ActiveWindow IO) ()
 -> Binder XKeyEvent (Action (ReaderT ActiveWindow IO) ()) ())
-> ReaderT ActiveWindow IO ()
-> Binder XKeyEvent (Action (ReaderT ActiveWindow IO) ()) ()
forall (m :: * -> *) b a.
Functor m =>
(Action m () -> b) -> m a -> b
`run` X11Front XKeyEvent -> XKeyEvent -> ReaderT ActiveWindow IO ()
forall k (m :: * -> *) i.
(ToXKeyEvent k, MonadIO m, MonadReader ActiveWindow m) =>
X11Front i -> k -> m ()
sendKey X11Front XKeyEvent
x11 (KeySym -> XKeyEvent
forall k. ToXKeyEvent k => k -> XKeyEvent
ctrl KeySym
xK_c)