{-# LANGUAGE CPP #-}
{- Obsolete OPTIONS -optc-I/usr/X11R6/include -#include <X11/Xlib.h> -#include <X11/Xutil.h> -fvia-C -}
module EncodeEvent(getNextEvent,motionCompress) where

import Event
import Xtypes
--import ResourceIds

import XCallTypes
import StructFuns
import Xlib
import Marshall
import MyForeign
import qualified Foreign as F

import FudUTF8(decodeUTF8)
import Data.Maybe(fromMaybe)
--import Ap

--import GlaExts hiding(Word) --(primIOToIO,CCallable,CReturnable,Addr)
--import MutableArray(MutableByteArray#)
--import PrelGHC
--import PrelBase
--import GhcWord
--import CString(unpackCStringIO)
--import Command
--import Font

#include "newstructfuns.h"

getNextEvent :: Display -> IO (WindowId, XEvent)
getNextEvent Display
d = do
   CXEvent
ev <- IO CXEvent
newXEvent
   Display -> CXEvent -> IO ()
xNextEvent Display
d CXEvent
ev
   WindowId
window <- GET(XAnyEvent,WindowId,ev,window)
   XEvent
fev <- CXEvent -> IO XEvent
encodeEvent CXEvent
ev
   (WindowId, XEvent) -> IO (WindowId, XEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (WindowId
window,XEvent
fev) -- no freePtr?!

checkWindowEvent :: Display -> WindowId -> [EventMask] -> IO (Maybe XEvent)
checkWindowEvent Display
d WindowId
w [EventMask]
evmask = do
   CXEvent
ev <- IO CXEvent
newXEvent
   Bool
found <- Display -> WindowId -> Int -> CXEvent -> IO Bool
xCheckWindowEvent Display
d WindowId
w ([EventMask] -> Int
forall a. ToC a => a -> Int
toC ([EventMask]
evmask::[EventMask])) CXEvent
ev
   if Bool
found
     then XEvent -> Maybe XEvent
forall a. a -> Maybe a
Just (XEvent -> Maybe XEvent) -> IO XEvent -> IO (Maybe XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CXEvent -> IO XEvent
encodeEvent CXEvent
ev
     else CXEvent -> IO ()
forall a. HasAddr a => a -> IO ()
freePtr CXEvent
ev IO () -> IO (Maybe XEvent) -> IO (Maybe XEvent)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe XEvent -> IO (Maybe XEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe XEvent
forall a. Maybe a
Nothing

motionCompress :: Display -> (WindowId, XEvent) -> IO (WindowId, XEvent)
motionCompress Display
d e :: (WindowId, XEvent)
e@(WindowId
w,fev :: XEvent
fev@MotionNotify{}) =
  do Maybe XEvent
me <- Display -> WindowId -> [EventMask] -> IO (Maybe XEvent)
checkWindowEvent Display
d WindowId
w [EventMask
PointerMotionMask]
     case Maybe XEvent
me of
       Maybe XEvent
Nothing -> (WindowId, XEvent) -> IO (WindowId, XEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (WindowId, XEvent)
e
       Just XEvent
fev' -> Display -> (WindowId, XEvent) -> IO (WindowId, XEvent)
motionCompress Display
d (WindowId
w,XEvent
fev')
motionCompress Display
_ (WindowId, XEvent)
e = (WindowId, XEvent) -> IO (WindowId, XEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (WindowId, XEvent)
e


encodeEvent :: CXEvent -> IO XEvent
encodeEvent CXEvent
ev = do
   Int
evno <- GET(XAnyEvent,Int,ev,type)
   case Int
evno :: Int of

{- ghc doesn't handle literal (``KeyPress'') patterns yet -}

#define X_KeyPress		2
#define X_KeyRelease		3
#define X_ButtonPress		4
#define X_ButtonRelease		5
#define X_MotionNotify		6
#define X_EnterNotify		7
#define X_LeaveNotify		8
#define X_FocusIn		9
#define X_FocusOut		10
#define X_KeymapNotify		11
#define X_Expose		12
#define X_GraphicsExpose	13
#define X_NoExpose		14
#define X_VisibilityNotify	15
#define X_CreateNotify		16
#define X_DestroyNotify		17
#define X_UnmapNotify		18
#define X_MapNotify		19
#define X_MapRequest		20
#define X_ReparentNotify	21
#define X_ConfigureNotify	22
#define X_ConfigureRequest	23
#define X_GravityNotify		24
#define X_ResizeRequest		25
#define X_CirculateNotify	26
#define X_CirculateRequest	27
#define X_PropertyNotify	28
#define X_SelectionClear	29
#define X_SelectionRequest	30
#define X_SelectionNotify	31
#define X_ColormapNotify	32
#define X_ClientMessage		33
#define X_MappingNotify		34
     X_KeyPress      	-> putKeyEvent ev Pressed
     X_KeyRelease    	-> putKeyEvent ev Released
     X_ButtonPress   	-> putButtonEvent ev Pressed
     X_ButtonRelease 	-> putButtonEvent ev Released
     X_MotionNotify  	-> putMotionEvent ev
     X_EnterNotify   	-> putCrossingEvent ev True
     X_LeaveNotify   	-> putCrossingEvent ev False
     X_FocusIn       	-> putFocusChangeEvent ev True
     X_FocusOut      	-> putFocusChangeEvent ev False
     X_KeymapNotify  	-> return KeymapNotify
     X_Expose	       	-> putExposeEvent ev
     X_GraphicsExpose	-> putGraphicsExposeEvent ev
     X_NoExpose		-> return NoExpose
     X_VisibilityNotify	-> putVisibilityEvent ev
     X_CreateNotify	-> putStructEvent ev CreateNotify
     X_DestroyNotify	-> putStructEvent ev DestroyNotify
     X_UnmapNotify	-> putStructEvent ev UnmapNotify
     X_MapNotify	-> putStructEvent ev MapNotify
     X_MapRequest	-> putStructEvent ev MapRequest
     X_ReparentNotify	-> return ReparentNotify
     X_ConfigureNotify	-> putConfigureEvent ev
     X_ConfigureRequest	-> return ConfigureRequest
     X_GravityNotify	-> return GravityNotify
     X_ResizeRequest	-> putResizeRequestEvent ev
     X_CirculateNotify	-> return CirculateNotify
     X_CirculateRequest	-> return CirculateRequest
     X_PropertyNotify	-> return PropertyNotify
     X_SelectionClear	-> putSelectionClearEvent ev
     X_SelectionRequest	-> putSelectionRequestEvent ev
     X_SelectionNotify	-> putSelectionNotifyEvent ev
     X_ColormapNotify	-> return ColormapNotify
     X_ClientMessage	-> putClientMessageEvent ev
     X_MappingNotify	-> return MappingNotify

mkClientData :: CXEvent -> IO ClientData
mkClientData CXEvent
ev = do
  Int
format <- GET(XClientMessageEvent,Int,ev,format)
  Addr
d <- AGET(XClientMessageEvent,Addr,ev,data)
  case Int
format::Int of
    Int
32 -> [Int] -> ClientData
Long ([Int] -> ClientData) -> IO [Int] -> IO ClientData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IO Int) -> [Int] -> IO [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CINDEX(long) Addr
(d::Addr)) Int
[0..(4::Int)]
    Int
16 -> [Int] -> ClientData
Short ([Int] -> ClientData) -> IO [Int] -> IO ClientData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IO Int) -> [Int] -> IO [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CINDEX(short) d) Int
[0..(9::Int)]
    Int
8  -> String -> ClientData
Byte (String -> ClientData) -> IO String -> IO ClientData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IO Cchar) -> [Int] -> IO String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CINDEX(char) d) Int
[0..(19::Int)]

putKeyEvent :: CXEvent -> Pressed -> IO XEvent
putKeyEvent CXEvent
ev Pressed
p = do
  (String
key,String
l) <- CXEvent -> Int -> IO (String, String)
xLookupString CXEvent
ev Int
100
  Int
-> Point
-> Point
-> ModState
-> Pressed
-> KeyCode
-> String
-> String
-> XEvent
KeyEvent
   (Int
 -> Point
 -> Point
 -> ModState
 -> Pressed
 -> KeyCode
 -> String
 -> String
 -> XEvent)
-> IO Int
-> IO
     (Point
      -> Point
      -> ModState
      -> Pressed
      -> KeyCode
      -> String
      -> String
      -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XKeyEvent,Time,ev,time)
   IO
  (Point
   -> Point
   -> ModState
   -> Pressed
   -> KeyCode
   -> String
   -> String
   -> XEvent)
-> IO Point
-> IO
     (Point
      -> ModState -> Pressed -> KeyCode -> String -> String -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XKeyEvent,Int,ev,x) GET(XKeyEvent,Int,ev,y)
   IO
  (Point
   -> ModState -> Pressed -> KeyCode -> String -> String -> XEvent)
-> IO Point
-> IO
     (ModState -> Pressed -> KeyCode -> String -> String -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XKeyEvent,Int,ev,x_root) GET(XKeyEvent,Int,ev,y_root)
   IO (ModState -> Pressed -> KeyCode -> String -> String -> XEvent)
-> IO ModState
-> IO (Pressed -> KeyCode -> String -> String -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> ModState) -> IO Int -> IO ModState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ModState
forall a. FromC a => Int -> a
fromC GET(XKeyEvent,Int,ev,state)
   IO (Pressed -> KeyCode -> String -> String -> XEvent)
-> IO Pressed -> IO (KeyCode -> String -> String -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pressed -> IO Pressed
forall (m :: * -> *) a. Monad m => a -> m a
return Pressed
p
   IO (KeyCode -> String -> String -> XEvent)
-> IO KeyCode -> IO (String -> String -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> KeyCode) -> IO Int -> IO KeyCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> KeyCode
KeyCode GET(XKeyEvent,Int,ev,keycode)
   IO (String -> String -> XEvent)
-> IO String -> IO (String -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
key
   IO (String -> XEvent) -> IO String -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
decodeUTF8 String
l)
             -- !! Assume that XLookupString returns a UTF-8 string
             -- https://gitlab.freedesktop.org/xorg/lib/libx11/-/issues/39

putButtonEvent :: CXEvent -> Pressed -> IO XEvent
putButtonEvent CXEvent
ev Pressed
p =
   Int -> Point -> Point -> ModState -> Pressed -> Button -> XEvent
ButtonEvent
   (Int -> Point -> Point -> ModState -> Pressed -> Button -> XEvent)
-> IO Int
-> IO (Point -> Point -> ModState -> Pressed -> Button -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XButtonEvent,Time,ev,time)
   IO (Point -> Point -> ModState -> Pressed -> Button -> XEvent)
-> IO Point
-> IO (Point -> ModState -> Pressed -> Button -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XButtonEvent,Int,ev,x) GET(XButtonEvent,Int,ev,y)
   IO (Point -> ModState -> Pressed -> Button -> XEvent)
-> IO Point -> IO (ModState -> Pressed -> Button -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XButtonEvent,Int,ev,x_root) GET(XButtonEvent,Int,ev,y_root)
   IO (ModState -> Pressed -> Button -> XEvent)
-> IO ModState -> IO (Pressed -> Button -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> ModState) -> IO Int -> IO ModState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ModState
forall a. FromC a => Int -> a
fromC GET(XButtonEvent,Int,ev,state)
   IO (Pressed -> Button -> XEvent)
-> IO Pressed -> IO (Button -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pressed -> IO Pressed
forall (m :: * -> *) a. Monad m => a -> m a
return Pressed
p
   IO (Button -> XEvent) -> IO Button -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Button) -> IO Int -> IO Button
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Button
Button GET(XButtonEvent,Int,ev,button)

putMotionEvent :: CXEvent -> IO XEvent
putMotionEvent CXEvent
ev =
   Int -> Point -> Point -> ModState -> XEvent
MotionNotify
   (Int -> Point -> Point -> ModState -> XEvent)
-> IO Int -> IO (Point -> Point -> ModState -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XMotionEvent,Time,ev,time)
   IO (Point -> Point -> ModState -> XEvent)
-> IO Point -> IO (Point -> ModState -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XMotionEvent,Int,ev,x) GET(XMotionEvent,Int,ev,y)
   IO (Point -> ModState -> XEvent)
-> IO Point -> IO (ModState -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XMotionEvent,Int,ev,x_root) GET(XMotionEvent,Int,ev,y_root)
   IO (ModState -> XEvent) -> IO ModState -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> ModState) -> IO Int -> IO ModState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ModState
forall a. FromC a => Int -> a
fromC GET(XMotionEvent,Int,ev,state)

putCrossingEvent :: CXEvent -> Bool -> IO XEvent
putCrossingEvent CXEvent
ev Bool
c =
   (if Bool
c then Int -> Point -> Point -> Detail -> Mode -> Bool -> XEvent
EnterNotify else Int -> Point -> Point -> Detail -> Mode -> Bool -> XEvent
LeaveNotify)
   (Int -> Point -> Point -> Detail -> Mode -> Bool -> XEvent)
-> IO Int
-> IO (Point -> Point -> Detail -> Mode -> Bool -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XCrossingEvent,Time,ev,time)
   IO (Point -> Point -> Detail -> Mode -> Bool -> XEvent)
-> IO Point -> IO (Point -> Detail -> Mode -> Bool -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XCrossingEvent,Int,ev,x) GET(XCrossingEvent,Int,ev,y)
   IO (Point -> Detail -> Mode -> Bool -> XEvent)
-> IO Point -> IO (Detail -> Mode -> Bool -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XCrossingEvent,Int,ev,x_root) GET(XCrossingEvent,Int,ev,y_root)
   IO (Detail -> Mode -> Bool -> XEvent)
-> IO Detail -> IO (Mode -> Bool -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Detail) -> IO Int -> IO Detail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Detail
forall a. FromC a => Int -> a
fromC GET(XCrossingEvent,Int,ev,detail)
   IO (Mode -> Bool -> XEvent) -> IO Mode -> IO (Bool -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Mode) -> IO Int -> IO Mode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Mode
forall a. FromC a => Int -> a
fromC GET(XCrossingEvent,Int,ev,mode)
   IO (Bool -> XEvent) -> IO Bool -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. FromC a => Int -> a
fromC GET(XCrossingEvent,Int,ev,focus)


putFocusChangeEvent :: CXEvent -> Bool -> IO XEvent
putFocusChangeEvent CXEvent
ev Bool
c =
   (if Bool
c then Detail -> Mode -> XEvent
FocusIn else Detail -> Mode -> XEvent
FocusOut)
   (Detail -> Mode -> XEvent) -> IO Detail -> IO (Mode -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Detail) -> IO Int -> IO Detail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Detail
forall a. FromC a => Int -> a
fromC GET(XFocusChangeEvent,Int,ev,detail)
   IO (Mode -> XEvent) -> IO Mode -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Mode) -> IO Int -> IO Mode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Mode
forall a. FromC a => Int -> a
fromC GET(XFocusChangeEvent,Int,ev,mode)

putExposeEvent :: CXEvent -> IO XEvent
putExposeEvent CXEvent
ev =
   Rect -> Int -> XEvent
Expose
   (Rect -> Int -> XEvent) -> IO Rect -> IO (Int -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int -> IO Int -> IO Int -> IO Int -> IO Rect
forall (f :: * -> *).
Applicative f =>
f Int -> f Int -> f Int -> f Int -> f Rect
mkRect GET(XExposeEvent,Int,ev,x) GET(XExposeEvent,Int,ev,y)
	       GET(XExposeEvent,Int,ev,width) GET(XExposeEvent,Int,ev,height) 
   IO (Int -> XEvent) -> IO Int -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XExposeEvent,Int,ev,count)

putGraphicsExposeEvent :: CXEvent -> IO XEvent
putGraphicsExposeEvent CXEvent
ev =
   Rect -> Int -> Int -> Int -> XEvent
GraphicsExpose 
   (Rect -> Int -> Int -> Int -> XEvent)
-> IO Rect -> IO (Int -> Int -> Int -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int -> IO Int -> IO Int -> IO Int -> IO Rect
forall (f :: * -> *).
Applicative f =>
f Int -> f Int -> f Int -> f Int -> f Rect
mkRect GET(XGraphicsExposeEvent,Int,ev,x) GET(XGraphicsExposeEvent,Int,ev,y)
	       GET(XGraphicsExposeEvent,Int,ev,width) GET(XGraphicsExposeEvent,Int,ev,height) 
   IO (Int -> Int -> Int -> XEvent)
-> IO Int -> IO (Int -> Int -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XGraphicsExposeEvent,Int,ev,count)
   IO (Int -> Int -> XEvent) -> IO Int -> IO (Int -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XGraphicsExposeEvent,Int,ev,major_code)
   IO (Int -> XEvent) -> IO Int -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XGraphicsExposeEvent,Int,ev,minor_code)

putVisibilityEvent :: CXEvent -> IO XEvent
putVisibilityEvent CXEvent
ev =
  Visibility -> XEvent
VisibilityNotify (Visibility -> XEvent) -> (Int -> Visibility) -> Int -> XEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Visibility
forall a. FromC a => Int -> a
fromC (Int -> XEvent) -> IO Int -> IO XEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XVisibilityEvent,Int,ev,state)

putStructEvent :: CXEvent -> (WindowId -> b) -> IO b
putStructEvent CXEvent
ev WindowId -> b
c = WindowId -> b
c (WindowId -> b) -> IO WindowId -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XMapEvent,WindowId,ev,window)

putConfigureEvent :: CXEvent -> IO XEvent
putConfigureEvent CXEvent
ev =
   Rect -> Int -> XEvent
ConfigureNotify
   (Rect -> Int -> XEvent) -> IO Rect -> IO (Int -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int -> IO Int -> IO Int -> IO Int -> IO Rect
forall (f :: * -> *).
Applicative f =>
f Int -> f Int -> f Int -> f Int -> f Rect
mkRect GET(XConfigureEvent,Int,ev,x) GET(XConfigureEvent,Int,ev,y)
               GET(XConfigureEvent,Int,ev,width) GET(XConfigureEvent,Int,ev,height)
   IO (Int -> XEvent) -> IO Int -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XConfigureEvent,Int,ev,border_width)

putResizeRequestEvent :: CXEvent -> IO XEvent
putResizeRequestEvent CXEvent
ev =
   Point -> XEvent
ResizeRequest 
  (Point -> XEvent) -> IO Point -> IO XEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int -> IO Int -> IO Point
forall (f :: * -> *). Applicative f => f Int -> f Int -> f Point
mkPoint GET(XResizeRequestEvent,Int,ev,width)
             GET(XResizeRequestEvent,Int,ev,height)

putSelectionClearEvent :: CXEvent -> IO XEvent
putSelectionClearEvent CXEvent
ev = Atom -> XEvent
SelectionClear
 (Atom -> XEvent) -> IO Atom -> IO XEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XSelectionClearEvent,Atom,ev,selection)

putSelectionRequestEvent :: CXEvent -> IO XEvent
putSelectionRequestEvent CXEvent
ev =
  Int -> WindowId -> Selection -> XEvent
SelectionRequest
  (Int -> WindowId -> Selection -> XEvent)
-> IO Int -> IO (WindowId -> Selection -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XSelectionRequestEvent,Time,ev,time)
  IO (WindowId -> Selection -> XEvent)
-> IO WindowId -> IO (Selection -> XEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XSelectionRequestEvent,WindowId,ev,requestor)
  IO (Selection -> XEvent) -> IO Selection -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Atom -> Atom -> Atom -> Selection
Selection (Atom -> Atom -> Atom -> Selection)
-> IO Atom -> IO (Atom -> Atom -> Selection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XSelectionRequestEvent,Atom,ev,selection)
		IO (Atom -> Atom -> Selection) -> IO Atom -> IO (Atom -> Selection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XSelectionRequestEvent,Atom,ev,target)
		IO (Atom -> Selection) -> IO Atom -> IO Selection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XSelectionRequestEvent,Atom,ev,property))

putSelectionNotifyEvent :: CXEvent -> IO XEvent
putSelectionNotifyEvent CXEvent
ev =
  Int -> Selection -> XEvent
SelectionNotify
  (Int -> Selection -> XEvent) -> IO Int -> IO (Selection -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XSelectionEvent,Time,ev,time)
  IO (Selection -> XEvent) -> IO Selection -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Atom -> Atom -> Atom -> Selection
Selection (Atom -> Atom -> Atom -> Selection)
-> IO Atom -> IO (Atom -> Atom -> Selection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XSelectionEvent,Atom,ev,selection)
		IO (Atom -> Atom -> Selection) -> IO Atom -> IO (Atom -> Selection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XSelectionEvent,Atom,ev,target)
		IO (Atom -> Selection) -> IO Atom -> IO Selection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GET(XSelectionEvent,Atom,ev,property))

putClientMessageEvent :: CXEvent -> IO XEvent
putClientMessageEvent CXEvent
ev =
  Atom -> ClientData -> XEvent
ClientMessage
  (Atom -> ClientData -> XEvent)
-> IO Atom -> IO (ClientData -> XEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GET(XClientMessageEvent,Atom,ev,message_type)
  IO (ClientData -> XEvent) -> IO ClientData -> IO XEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CXEvent -> IO ClientData
mkClientData CXEvent
ev

foreign import ccall "X11/Xlib.h XLookupString"
  cXLookupString :: CXKeyEvent -> Addr -> Int -> F.Ptr XlibKeySym -> Addr -> IO Int

xLookupString :: CXKeyEvent -> Int -> IO (KeySym,String)
xLookupString :: CXEvent -> Int -> IO (String, String)
xLookupString CXEvent
xev Int
len =
    Int -> (Addr -> IO (String, String)) -> IO (String, String)
forall c. Int -> (Addr -> IO c) -> IO c
alloca Int
len ((Addr -> IO (String, String)) -> IO (String, String))
-> (Addr -> IO (String, String)) -> IO (String, String)
forall a b. (a -> b) -> a -> b
$ \ Addr
arr ->
    (Ptr XlibKeySym -> IO (String, String)) -> IO (String, String)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr XlibKeySym -> IO (String, String)) -> IO (String, String))
-> (Ptr XlibKeySym -> IO (String, String)) -> IO (String, String)
forall a b. (a -> b) -> a -> b
$ \ Ptr XlibKeySym
keysyma ->
    do Int
len' <- {- _casm_ ``%r=(int)XLookupString((XKeyEvent *)%0,
					  (char *)%1,
					  (int)%2,
					  (KeySym *)%3,
					  NULL);'' xev arr len keysyma -}
           CXEvent -> Addr -> Int -> Ptr XlibKeySym -> Addr -> IO Int
cXLookupString CXEvent
xev Addr
arr Int
len Ptr XlibKeySym
keysyma Addr
nullAddr
       XlibKeySym
keysym <- Ptr XlibKeySym -> IO XlibKeySym
forall a. Storable a => Ptr a -> IO a
F.peek Ptr XlibKeySym
keysyma
       Maybe String
key <- XlibKeySym -> IO (Maybe String)
xKeysymToString XlibKeySym
keysym
       let key' :: String
key' = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"(undefined)" Maybe String
key
       String
str <- CString -> Int -> IO String
unmarshallString' (Addr -> CString
CString Addr
arr) Int
len'
       (String, String) -> IO (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
key',String
str)

instance FromC Detail where fromC :: Int -> Detail
fromC = Detail -> Int -> Detail
forall a p. Enum a => p -> Int -> a
toEnum' Detail
NotifyAncestor
instance FromC Mode where fromC :: Int -> Mode
fromC = Mode -> Int -> Mode
forall a p. Enum a => p -> Int -> a
toEnum' Mode
NotifyNormal
instance FromC Visibility where fromC :: Int -> Visibility
fromC = Visibility -> Int -> Visibility
forall a p. Enum a => p -> Int -> a
toEnum' Visibility
VisibilityUnobscured


instance F.Storable XID where
  sizeOf :: XlibKeySym -> Int
sizeOf (XID Int
x) = Int -> Int
forall a. Storable a => a -> Int
F.sizeOf Int
x
  alignment :: XlibKeySym -> Int
alignment (XID Int
x) = Int -> Int
forall a. Storable a => a -> Int
F.alignment Int
x

  peek :: Ptr XlibKeySym -> IO XlibKeySym
peek Ptr XlibKeySym
a = (Int -> XlibKeySym) -> IO Int -> IO XlibKeySym
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> XlibKeySym
XID (Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
F.peek (Ptr XlibKeySym -> Ptr Int
forall a b. Ptr a -> Ptr b
F.castPtr Ptr XlibKeySym
a))
  poke :: Ptr XlibKeySym -> XlibKeySym -> IO ()
poke Ptr XlibKeySym
a (XID Int
x) = Ptr Int -> Int -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke (Ptr XlibKeySym -> Ptr Int
forall a b. Ptr a -> Ptr b
F.castPtr Ptr XlibKeySym
a) Int
x