{-# LANGUAGE CPP #-}
module Xlib where
import Marshall
import MyForeign
import CSizes
import Xtypes
import Visual
import Font(FontDirection)
import CString16(CString16)
import DrawTypes
import Control.Monad(zipWithM_)
import Data.Word(Word,Word32)
default(Int)
#include "structs.h"
type Unsigned = Int
type Unsigned32 = Int32
type Status = Int
type Screen = Int
type Bitmask = Word32
type XlibKeySym = XID
type ClipOrdering = Ordering'
type CPixelArray = CLong
type CStringArray = CString
type CXFontStructArray = CXFontStruct
type CDisplay = Addr
type CGCId = Addr
newtype Region = Region Addr
#define FI(f) foreign import ccall unsafe "f" prim/**/f
#define PXlib(f,p,h) FI(X/**/f) :: p ; x/**/f :: h ; x/**/f = call primX/**/f
#define Xlib(f,h) PXlib(f,h,h)
#define PReq0(f,pr,r) PXlib(f,CDisplay -> IO pr, Display -> IO r)
#define Req0(f,r) PReq0(f,r,r)
#define Req(f,t,r) PReq(f,t,r,t,r)
#define PReq(f,p,pr,t,r) PXlib(f,CDisplay -> p -> IO pr, Display-> t ->IO r)
#define WindowReq(f,t,r) Req(f,Window->t,r)
#define PWindowReq(f,pt,pr,t,r) PReq(f,Window->pt,pr,Window->t,r)
#define WindowReqP(f,t,pr,r) PReq(f,Window->t,pr,Window->t,r)
#define DrawReq(f,t,r) Req(f,DrawableId->t,r)
#define DrawReqP(f,t,pr,r) PReq(f,DrawableId->t,pr,DrawableId->t,r)
#define Cmd0(f) PXlib(f,CDisplay -> IO (), Display-> IO ())
#define Cmd(f,t) Req(f,t,())
#define PCmd(f,p,t) PXlib(f,CDisplay -> p -> IO (), Display-> t ->IO ())
#define WindowCmd0(f) Cmd(f,Window)
#define WindowCmd(f,t) Cmd(f,Window->t)
#define PWindowCmd(f,p,t) PCmd(f,Window->p,Window->t)
#define DrawCmd(f,t) PCmd(f,DrawableId->CGCId->t,DrawableId->GCId->t)
#define DrawPCmd(f,p,t) PCmd(f,DrawableId->CGCId->p,DrawableId->GCId->t)
PXlib(OpenDisplay, CString -> IO CDisplay, String -> IO Display)
Cmd0(CloseDisplay)
Req0(ConnectionNumber,Int32)
Cmd0(Flush)
Cmd(NextEvent,CXEvent)
WindowReq(CheckWindowEvent,Int->CXEvent,Bool)
Req0(Pending,Int)
Cmd(FreePixmap,PixmapId)
Cmd(Synchronize,Bool)
Cmd(Sync,Bool)
Cmd(Bell,Int)
FI(XInitThreads) :: IO Int
xInitThreads :: IO Bool
xInitThreads = (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0) IO Int
primXInitThreads
Cmd0(LockDisplay)
Cmd0(UnlockDisplay)
FI(XFree) :: Addr -> IO ()
xFree :: a -> IO ()
xFree a
p = CDisplay -> IO ()
primXFree (a -> CDisplay
forall a. HasAddr a => a -> CDisplay
addrOf a
p)
Req0(DefaultScreen,Screen)
Req0(DefaultRootWindow,Window)
PReq0(ImageByteOrder,Int,ByteOrder)
Req(DefaultDepth,Screen,Int)
Req(BlackPixel,Int,Unsigned)
Req(WhitePixel,Int,Unsigned)
Req(DefaultColormap,Int,ColormapId)
Req(DefaultVisual,Screen,CVisual)
PReq(LoadFont,CString,FontId,String,FontId)
Req(QueryFont,FontId,CXFontStruct)
PReq(LoadQueryFont,CString,CXFontStruct,String,CXFontStruct)
PReq(ListFonts,CString->Int->CLong,CStringArray,String->Int->CLong,CStringArray)
Xlib(FreeFontNames,CStringArray->IO())
PReq(ListFontsWithInfo,CString->Int->CInt32->CCXFontStruct,CStringArray,String->Int->CInt32->CCXFontStruct,CStringArray)
Xlib(FreeFontInfo,CStringArray->CXFontStructArray->Int32->IO ())
Cmd(QueryTextExtents16,FontId->CString16->Int->CLong->CLong->CLong->CXCharStruct)
Req(CreateFontCursor,Int,CursorId)
Req(CreatePixmap,DrawableId->Unsigned->Unsigned->Unsigned,PixmapId)
PReq(InternAtom,CString->Bool,Atom,String->Bool,Atom)
Req(GetAtomName,Atom,CString)
Req(AllocColor,ColormapId->CXColor,Status)
PReq(AllocNamedColor,ColormapId->CString->CXColor->CXColor,Status,ColormapId->String->CXColor->CXColor,Status)
Cmd(QueryColor,ColormapId->CXColor)
Cmd(FreeColors,ColormapId->CPixelArray->Int->Pixel)
Req(CreateImage,CVisual->Int->Int->Int->CString->Int->Int->Int->Int,CXImage)
DrawCmd(PutImage,CXImage->Int32->Int32->Int32->Int32->Int32->Int32)
foreign import ccall "asyncinput.h" xDestroyImage :: CXImage -> IO ()
WindowCmd0(DestroyWindow)
WindowCmd0(MapRaised)
WindowCmd0(LowerWindow)
WindowCmd0(UnmapWindow)
WindowCmd0(ClearWindow)
WindowCmd(ClearArea,Int->Int->Int->Int->Bool)
WindowReq(CreateSimpleWindow,Int->Int->Unsigned->Unsigned->Unsigned->Unsigned->Unsigned,Window)
PWindowCmd(StoreName,CString,String)
WindowCmd(SetClassHint,CXClassHint)
WindowCmd(ConfigureWindow,Bitmask->CXWindowChanges)
WindowCmd(ChangeWindowAttributes,Bitmask->CXSetWindowAttributes)
WindowCmd(ReparentWindow,Window->Int->Int)
PWindowCmd(SetWMProtocols,CAtomArray->Int,[Atom]->Int)
WindowCmd(SetNormalHints,CXSizeHints)
WindowCmd(SetWMHints,CXWMHints)
WindowReq(SendEvent,Bool->Bitmask->CXEvent,Status)
PWindowCmd(ChangeProperty,Atom->Atom->Int->PropertyMode->CString->Int,Atom->Atom->Int->PropertyMode->String->Int)
WindowReq(GetWindowProperty,Atom->Int->Int->Bool->Atom->CAtom->CLong->CLong->CLong->CCString,Int)
WindowReq(QueryPointer,CLong->CLong->CLong->CLong->CLong->CLong->CLong,Bool)
WindowReq(TranslateCoordinates,Window->Int->Int->CInt32->CInt32->CLong,Bool)
PWindowCmd(ShapeCombineMask,Int->Int->Int->PixmapId->Int,ShapeKind->Int->Int->PixmapId->ShapeOperation)
PWindowCmd(ShapeCombineRectangles,Int->Int->Int->CXRectangleArray->Int->Int->Int,ShapeKind->Int->Int->CXRectangleArray->Int->ShapeOperation->ClipOrdering)
PWindowCmd(ShapeCombineShape,Int->Int->Int->PixmapId->Int->Int,ShapeKind->Int->Int->PixmapId->ShapeKind->ShapeOperation)
Cmd(GrabButton,Int->Int->Window->Bool->Unsigned->Int->Int->Window->CursorId)
Cmd(UngrabButton,Int->Int->Window)
WindowReqP(GrabPointer,Bool->Unsigned->Int->Int->Window->CursorId->Time,Int,GrabPointerResult)
Cmd(UngrabPointer,Time)
Cmd(SetSelectionOwner,Atom->Window->Time)
Cmd(ConvertSelection,Atom->Atom->Atom->Window->Time)
DrawCmd(DrawPoint,Int->Int)
DrawCmd(DrawLine,Int->Int->Int->Int)
DrawPCmd(DrawLines,CXPointArray->Int->Int,CXPointArray->Int->CoordMode)
DrawPCmd(DrawImageString,Int->Int->CString->Int,Int->Int->String->Int)
DrawPCmd(DrawString,Int->Int->CString->Int,Int->Int->String->Int)
DrawPCmd(DrawImageString16,Int->Int->CString16->Int,Int->Int->CString16->Int)
DrawPCmd(DrawString16,Int->Int->CString16->Int,Int->Int->CString16->Int)
DrawCmd(DrawRectangle,Int->Int->Int->Int)
DrawCmd(FillRectangle,Int->Int->Int->Int)
DrawCmd(DrawArc,Int32->Int32->Unsigned32->Unsigned32->Int32->Int32)
DrawCmd(FillArc,Int32->Int32->Unsigned32->Unsigned32->Int32->Int32)
DrawPCmd(FillPolygon,CXPointArray->Int->Int->Int,CXPointArray->Int->Shape->CoordMode)
PCmd(CopyArea,DrawableId->DrawableId->CGCId->Int32->Int32->Unsigned32->Unsigned32->Int32->Int32,DrawableId->DrawableId->GCId->Int32->Int32->Unsigned32->Unsigned32->Int32->Int32)
PCmd(CopyPlane,DrawableId->DrawableId->CGCId->Int32->Int32->Unsigned32->Unsigned32->Int32->Int32->Word,DrawableId->DrawableId->GCId->Int32->Int32->Unsigned32->Unsigned32->Int32->Int32->Word)
#define GCCmd(f,t) PCmd(f,CGCId->t,GCId->t)
DrawReqP(CreateGC,Bitmask->CXGCValues,CGCId,GCId)
PCmd(CopyGC,CGCId->Bitmask->CGCId,GCId->Bitmask->GCId)
GCCmd(ChangeGC,Bitmask->CXGCValues)
PCmd(FreeGC,CGCId,GCId)
GCCmd(SetForeground,Unsigned)
GCCmd(SetBackground,Unsigned)
GCCmd(SetPlaneMask,Bitmask)
PCmd(SetFunction,CGCId->Int,GCId->GCFunction)
PCmd(SetState,CGCId->Unsigned->Unsigned->Int->Unsigned,GCId->Unsigned->Unsigned->GCFunction->Unsigned)
PXlib(KeysymToString,XlibKeySym->IO CString,XlibKeySym->IO (Maybe String))
Req(ReadBitmapFile,DrawableId->CString->CInt32->CInt32->CXID->CInt32->CInt32,Int)
Req(CreateBitmapFromData,DrawableId->CString->Int32->Int32,PixmapId)
Xlib(CreateRegion,IO Region)
PCmd(SetRegion,CGCId->Region,GCId->Region)
Xlib(DestroyRegion,Region->IO ())
Xlib(UnionRectWithRegion,CXRectangle->Region->Region->IO ())
IDAR(Region)
Req(dbeQueryExtension,CLong->CLong,Int)
PWindowReq(dbeAllocateBackBufferName,Int,DbeBackBufferId,SwapAction,DbeBackBufferId)
Req(dbeSwapBuffers,CXdbeSwapInfoArray->Int,Status)
H_ARRAY(XdbeSwapInfo)
ENUMAR(SwapAction)
IDAR(DbeBackBufferId)
IORC(CDisplay,Display,fmap (Display . a2i))
instance PrimArg Display CDisplay c where marshall :: (CDisplay -> c) -> Display -> c
marshall CDisplay -> c
c (Display Int
d) = CDisplay -> c
c (Int -> CDisplay
i2a Int
d)
IORC(CGCId,GCId,fmap (GCId . a2i))
instance PrimArg GCId CGCId c where marshall :: (CDisplay -> c) -> GCId -> c
marshall CDisplay -> c
c (GCId Int
d) = CDisplay -> c
c (Int -> CDisplay
i2a Int
d)
IDAR(Atom)
IDAR(ColormapId)
IDAR(CursorId)
IDAR(DrawableId)
IDAR(FontId)
IDAR(Pixel)
IDAR(PixmapId)
IDAR(PropertyMode)
IDAR(VisualID)
IDAR(Window)
IDAR0(Word32)
IDAR0(Word)
IDAR0(XID)
ENUMAR(ByteOrder)
ENUMAR(CoordMode)
ENUMAR(DisplayClass)
ENUMAR(FontDirection)
ENUMAR(GrabPointerResult)
ENUMAR(GCFunction)
ENUMAR(GCLineStyle)
ENUMAR(GCCapStyle)
ENUMAR(GCJoinStyle)
ENUMAR(GCSubwindowMode)
ENUMAR(GCFillStyle)
ENUMAR(ClipOrdering)
ENUMAR(Shape)
ENUMAR(ShapeKind)
ENUMAR(ShapeOperation)
IDAR0(CXID)
ISTORE(XID)
instance CVar CXID XID
H_STRUCTTYPE(XColor)
H_STRUCTTYPE(XClassHint)
H_STRUCTTYPE(XGCValues)
H_STRUCTTYPE(XSetWindowAttributes)
H_STRUCTTYPE(XSizeHints)
H_STRUCTTYPE(XWMHints)
H_STRUCTTYPE(XWindowChanges)
H_ARRAY(Atom)
ISTORE(Atom)
instance CVar CAtom Atom
instance PrimArg [Atom] CAtom (Int->IO a) where
marshall :: (CAtomArray -> Int -> IO a) -> [Atom] -> Int -> IO a
marshall CAtomArray -> Int -> IO a
pf [Atom]
as Int
n =
do CAtomArray
aa <- Int -> IO CAtomArray
forall a. IsPtr a => Int -> IO a
newArray Int
n
(Int -> Int -> IO ()) -> [Int] -> [Int] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (CDisplay -> Int -> Int -> IO ()
forall a. Storable a => CDisplay -> Int -> a -> IO ()
pokeElemOff (CAtomArray -> CDisplay
forall a. HasAddr a => a -> CDisplay
addrOf CAtomArray
aa)) [Int
0..(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)] [Int
a|Atom Int
a<-[Atom]
as]
a
r<-CAtomArray -> Int -> IO a
pf CAtomArray
aa Int
n
CAtomArray -> IO ()
forall a. HasAddr a => a -> IO ()
freePtr CAtomArray
aa
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
H_STRUCTTYPE(XEvent)
type CXAnyEvent = CXEvent
type CXKeyEvent = CXEvent
type CXButtonEvent = CXEvent
type CXMotionEvent = CXEvent
type CXCrossingEvent = CXEvent
type CXFocusChangeEvent = CXEvent
type CXExposeEvent = CXEvent
type CXGraphicsExposeEvent = CXEvent
type CXNoExposeEvent = CXEvent
type CXVisibilityEvent = CXEvent
type CXCreateWindowEvent = CXEvent
type CXDestroyWindowEvent = CXEvent
type CXUnmapEvent = CXEvent
type CXMapEvent = CXEvent
type CXMapRequestEvent = CXEvent
type CXReparentEvent = CXEvent
type CXConfigureEvent = CXEvent
type CXGravityEvent = CXEvent
type CXResizeRequestEvent = CXEvent
type CXConfigureRequestEvent = CXEvent
type CXCirculateEvent = CXEvent
type CXClientMessageEvent = CXEvent
type CXSelectionClearEvent = CXEvent
type CXSelectionRequestEvent = CXEvent
type CXSelectionEvent = CXEvent
H_ARRAY(XPoint)
H_ARRAY(XRectangle)
C_STRUCTTYPE(XFontStruct);IDAR0(CXFontStruct)
NEWTYPE(HT(XCharStruct));IPTR(XCharStruct);ISTORE(HT(XCharStruct));
INSTCCALL(HT(XCharStruct));IDAR0(CXCharStruct)
C_STRUCTTYPE(Visual);IDAR0(CVisual)
C_STRUCTTYPE(XImage);IDAR0(CXImage)
INSTCCALL(CString)
NEWTYPE(HT(XFontProp));IPTR(XFontProp);ISTORE(HT(XFontProp));
INSTCCALL(HT(XFontProp));IDAR0(CXFontProp)
C_STRUCTTYPE(CXFontStruct);IDAR0(CCXFontStruct)
newCXFontStruct :: IO CCXFontStruct
newCXFontStruct = CDisplay -> CCXFontStruct
CCXFontStruct (CDisplay -> CCXFontStruct) -> IO CDisplay -> IO CCXFontStruct
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CDisplay -> IO CDisplay
forall a. Storable a => a -> IO CDisplay
mallocElem CDisplay
nullAddr
instance CVar CCXFontStruct CXFontStruct
C_STRUCTTYPE(CString);IDAR0(CCString)
newCString :: IO CCString
newCString = CDisplay -> CCString
CCString (CDisplay -> CCString) -> IO CDisplay -> IO CCString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CDisplay -> IO CDisplay
forall a. Storable a => a -> IO CDisplay
mallocElem CDisplay
nullAddr
instance CVar CCString CString
anyModifier :: Int
anyModifier = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
15 :: Int)
grabModeAsync :: Int
grabModeAsync = Int
1 :: Int
call :: prim -> haskell
call prim
f = prim -> haskell
forall prim haskell. PrimResult prim haskell => prim -> haskell
unmarshall prim
f
uio :: (a -> b) -> f a -> f b
uio a -> b
f = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f
a2i :: Addr -> Int
a2i :: CDisplay -> Int
a2i CDisplay
a = CDisplay -> CDisplay -> Int
minusAddr CDisplay
a CDisplay
nullAddr
{-# NOINLINE i2a #-}
i2a :: Int -> Addr
i2a :: Int -> CDisplay
i2a = CDisplay -> Int -> CDisplay
plusAddr CDisplay
nullAddr
newtype DrawableId = DrawableId XID deriving Int -> DrawableId -> ShowS
[DrawableId] -> ShowS
DrawableId -> String
(Int -> DrawableId -> ShowS)
-> (DrawableId -> String)
-> ([DrawableId] -> ShowS)
-> Show DrawableId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DrawableId] -> ShowS
$cshowList :: [DrawableId] -> ShowS
show :: DrawableId -> String
$cshow :: DrawableId -> String
showsPrec :: Int -> DrawableId -> ShowS
$cshowsPrec :: Int -> DrawableId -> ShowS
Show
getdrawable :: Window -> Drawable -> DrawableId
getdrawable Window
_ (Pixmap (PixmapId XlibKeySym
i)) = XlibKeySym -> DrawableId
DrawableId XlibKeySym
i
getdrawable (WindowId XlibKeySym
w) Drawable
MyWindow = XlibKeySym -> DrawableId
DrawableId XlibKeySym
w
getdrawable Window
_ (DbeBackBuffer (DbeBackBufferId XlibKeySym
b)) = XlibKeySym -> DrawableId
DrawableId XlibKeySym
b
dcmap :: Display -> ColormapId -> IO ColormapId
dcmap Display
display ColormapId
cmap =
if ColormapId
cmap ColormapId -> ColormapId -> Bool
forall a. Eq a => a -> a -> Bool
== ColormapId
defaultColormap
then Display -> IO Int
xDefaultScreen Display
display IO Int -> (Int -> IO ColormapId) -> IO ColormapId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Display -> Int -> IO ColormapId
xDefaultColormap Display
display
else ColormapId -> IO ColormapId
forall (m :: * -> *) a. Monad m => a -> m a
return ColormapId
cmap
data ByteOrder = LSBFirst | MSBFirst deriving (ByteOrder -> ByteOrder -> Bool
(ByteOrder -> ByteOrder -> Bool)
-> (ByteOrder -> ByteOrder -> Bool) -> Eq ByteOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByteOrder -> ByteOrder -> Bool
$c/= :: ByteOrder -> ByteOrder -> Bool
== :: ByteOrder -> ByteOrder -> Bool
$c== :: ByteOrder -> ByteOrder -> Bool
Eq,Int -> ByteOrder
ByteOrder -> Int
ByteOrder -> [ByteOrder]
ByteOrder -> ByteOrder
ByteOrder -> ByteOrder -> [ByteOrder]
ByteOrder -> ByteOrder -> ByteOrder -> [ByteOrder]
(ByteOrder -> ByteOrder)
-> (ByteOrder -> ByteOrder)
-> (Int -> ByteOrder)
-> (ByteOrder -> Int)
-> (ByteOrder -> [ByteOrder])
-> (ByteOrder -> ByteOrder -> [ByteOrder])
-> (ByteOrder -> ByteOrder -> [ByteOrder])
-> (ByteOrder -> ByteOrder -> ByteOrder -> [ByteOrder])
-> Enum ByteOrder
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ByteOrder -> ByteOrder -> ByteOrder -> [ByteOrder]
$cenumFromThenTo :: ByteOrder -> ByteOrder -> ByteOrder -> [ByteOrder]
enumFromTo :: ByteOrder -> ByteOrder -> [ByteOrder]
$cenumFromTo :: ByteOrder -> ByteOrder -> [ByteOrder]
enumFromThen :: ByteOrder -> ByteOrder -> [ByteOrder]
$cenumFromThen :: ByteOrder -> ByteOrder -> [ByteOrder]
enumFrom :: ByteOrder -> [ByteOrder]
$cenumFrom :: ByteOrder -> [ByteOrder]
fromEnum :: ByteOrder -> Int
$cfromEnum :: ByteOrder -> Int
toEnum :: Int -> ByteOrder
$ctoEnum :: Int -> ByteOrder
pred :: ByteOrder -> ByteOrder
$cpred :: ByteOrder -> ByteOrder
succ :: ByteOrder -> ByteOrder
$csucc :: ByteOrder -> ByteOrder
Enum)