{-# LANGUAGE CPP #-}
{- Obsolete OPTIONS -optc-I/usr/X11R6/include -#include <X11/Xlib.h> -#include <X11/Xutil.h> -#include <X11/extensions/shape.h> -#include <X11/extensions/Xdbe.h> -fvia-C -}
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 Ap
import Data.Word(Word,Word32)
--import CCall
default(Int)

#include "structs.h"

type Unsigned = Int -- hmm
type Unsigned32 = Int32 -- hmm
type Status = Int
type Screen = Int
type Bitmask = Word32
type XlibKeySym = XID -- KeySym in Xlib, defined as String in Fudgets
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)

--- Calls ---------------------------------------------------------------------
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) -- result is ignored.
Cmd(Sync,Bool)
Cmd(Bell,Int)

FI(XInitThreads) :: IO Int
xInitThreads :: IO Bool
xInitThreads = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 (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->CInt32->CInt32->CInt32->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)
{- -- This creates a dangling reference to the image data!
PReq(CreateImage,CVisual->Int->Int->Int->CString->Int->Int->Int->Int,CXImage,
                 CVisual->Int->Int->Int->String->Int->Int->Int->Int,CXImage)
-}
Req(CreateImage,CVisual->Int->Int->Int->CString->Int->Int->Int->Int,CXImage)

DrawCmd(PutImage,CXImage->Int32->Int32->Int32->Int32->Int32->Int32)

-- Xlib(DestroyImage,CXImage->IO ()) -- XDestroyImage is a macro in X11/Xutil.h
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)

--- Regions -------------------------------------------------------------------
Xlib(CreateRegion,IO Region)
PCmd(SetRegion,CGCId->Region,GCId->Region)
Xlib(DestroyRegion,Region->IO ())
Xlib(UnionRectWithRegion,CXRectangle->Region->Region->IO ())
IDAR(Region)

--- Double buffer extension ---------------------------------------------------
Req(dbeQueryExtension,CLong->CLong,Int)
PWindowReq(dbeAllocateBackBufferName,Int,DbeBackBufferId,SwapAction,DbeBackBufferId)
Req(dbeSwapBuffers,CXdbeSwapInfoArray->Int,Status)

H_ARRAY(XdbeSwapInfo)
ENUMAR(SwapAction)
IDAR(DbeBackBufferId)
--- Types ---------------------------------------------------------------------

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)


-- Instances for resource identifiers and simple values
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

--- Structured types ----------------------------------------------------------
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 :: (CAtom -> Int -> IO a) -> [Atom] -> Int -> IO a
marshall CAtom -> Int -> IO a
pf [Atom]
as Int
n =
    do CAtom
aa <- forall a. IsPtr a => Int -> IO a
newArray Int
n
       forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (forall a. Storable a => CDisplay -> Int -> a -> IO ()
pokeElemOff (forall a. HasAddr a => a -> CDisplay
addrOf CAtom
aa)) [Int
0..(Int
nforall a. Num a => a -> a -> a
-Int
1)] [Int
a|Atom Int
a<-[Atom]
as]
       a
r<-CAtom -> Int -> IO a
pf CAtom
aa Int
n
       forall {a}. HasAddr a => a -> IO ()
freePtr CAtom
aa
       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)

--C_STRUCTTYPE(XCharStruct);IDAR0(CXCharStruct)
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}. Storable a => a -> IO CDisplay
mallocElem CDisplay
nullAddr
instance CVar CCString CString
--- Constants -----------------------------------------------------------------
anyModifier :: Int
anyModifier = Int
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
15 :: Int)
grabModeAsync :: Int
grabModeAsync = Int
1 :: Int
--- Auxiliary functions/types -------------------------------------------------
call :: prim -> haskell
call prim
f = forall {prim} {haskell}. PrimResult prim haskell => prim -> haskell
unmarshall prim
f
uio :: (a -> b) -> f a -> f b
uio a -> b
f = 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 #-} -- Workaround a GHC bug on 64-bit systems /TH 2016-12-29
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
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 XID
i)) = XID -> DrawableId
DrawableId XID
i
getdrawable (WindowId XID
w) Drawable
MyWindow = XID -> DrawableId
DrawableId XID
w
getdrawable Window
_ (DbeBackBuffer (DbeBackBufferId XID
b)) = XID -> DrawableId
DrawableId XID
b

dcmap :: Display -> ColormapId -> IO ColormapId
dcmap Display
display ColormapId
cmap =
    if ColormapId
cmap forall a. Eq a => a -> a -> Bool
== ColormapId
defaultColormap
    then Display -> IO Int
xDefaultScreen Display
display forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Display -> Int -> IO ColormapId
xDefaultColormap Display
display
    else forall (m :: * -> *) a. Monad m => a -> m a
return ColormapId
cmap

data ByteOrder = LSBFirst | MSBFirst deriving (ByteOrder -> ByteOrder -> Bool
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]
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)

--withLockedDisplay display cmd = cmd
{-
withLockedDisplay display cmd =
  do xLockDisplay display
     result <- cmd
     xUnlockDisplay display
     return result
-}