Some initial systray code
This commit is contained in:
parent
b66d6690d8
commit
0fefcaa35f
10 changed files with 213 additions and 32 deletions
|
@ -1,10 +1,13 @@
|
|||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
|
||||
module Phi.Bindings.Util ( setClassHint
|
||||
, visualIDFromVisual
|
||||
, putClientMessage
|
||||
, createXlibSurface
|
||||
) where
|
||||
|
||||
|
||||
#include <X11/Xlib.h>
|
||||
#include <X11/Xutil.h>
|
||||
#include <cairo.h>
|
||||
#include <cairo-xlib.h>
|
||||
|
@ -14,6 +17,7 @@ import Foreign.C.String (withCString)
|
|||
import Foreign.C.Types
|
||||
import Foreign.Ptr
|
||||
import Foreign.Marshal.Alloc (alloca, allocaBytes)
|
||||
import Foreign.Marshal.Array
|
||||
import Foreign.Storable
|
||||
|
||||
import Graphics.X11.Xlib
|
||||
|
@ -33,6 +37,17 @@ setClassHint disp wnd hint = allocaBytes (#size XClassHint) $ \p ->
|
|||
(#poke XClassHint, res_class) p res_class
|
||||
xSetClassHint disp wnd p
|
||||
|
||||
foreign import ccall unsafe "X11/Xlib.h XVisualIDFromVisual"
|
||||
visualIDFromVisual :: Visual -> VisualID
|
||||
|
||||
putClientMessage :: XEventPtr -> Window -> Atom -> [CLong] -> IO ()
|
||||
putClientMessage event window message_type messageData = do
|
||||
setEventType event clientMessage
|
||||
(#poke XClientMessageEvent, window) event window
|
||||
(#poke XClientMessageEvent, message_type) event message_type
|
||||
(#poke XClientMessageEvent, format) event (32 :: CInt)
|
||||
pokeArray ((#ptr XClientMessageEvent, data.l) event) $ take 5 messageData
|
||||
|
||||
foreign import ccall unsafe "cairo-xlib.h cairo_xlib_surface_create"
|
||||
xlibSurfaceCreate :: Display -> Drawable -> Visual -> CInt -> CInt -> IO (Ptr Surface)
|
||||
|
||||
|
@ -42,3 +57,4 @@ createXlibSurface dpy drawable visual width height = do
|
|||
surface <- mkSurface surfacePtr
|
||||
manageSurface surface
|
||||
return surface
|
||||
|
||||
|
|
Reference in a new issue