Added basic rendering functions
This commit is contained in:
parent
982bcffcfe
commit
5c9c99b41c
8 changed files with 194 additions and 20 deletions
44
lib/Phi/Bindings/Util.hsc
Normal file
44
lib/Phi/Bindings/Util.hsc
Normal file
|
@ -0,0 +1,44 @@
|
|||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
|
||||
module Phi.Bindings.Util ( setClassHint
|
||||
, createXlibSurface
|
||||
) where
|
||||
|
||||
|
||||
#include <X11/Xutil.h>
|
||||
#include <cairo.h>
|
||||
#include <cairo-xlib.h>
|
||||
|
||||
|
||||
import Foreign.C.String (withCString)
|
||||
import Foreign.C.Types
|
||||
import Foreign.Ptr
|
||||
import Foreign.Marshal.Alloc (alloca, allocaBytes)
|
||||
import Foreign.Storable
|
||||
|
||||
import Graphics.X11.Xlib
|
||||
import Graphics.X11.Xlib.Extras
|
||||
|
||||
import Graphics.Rendering.Cairo.Types
|
||||
|
||||
|
||||
foreign import ccall unsafe "X11/Xutil.h XSetClassHint"
|
||||
xSetClassHint :: Display -> Window -> Ptr ClassHint -> IO ()
|
||||
|
||||
setClassHint :: Display -> Window -> ClassHint -> IO ()
|
||||
setClassHint disp wnd hint = allocaBytes (#size XClassHint) $ \p ->
|
||||
withCString (resName hint) $ \res_name ->
|
||||
withCString (resClass hint) $ \res_class -> do
|
||||
(#poke XClassHint, res_name) p res_name
|
||||
(#poke XClassHint, res_class) p res_class
|
||||
xSetClassHint disp wnd p
|
||||
|
||||
foreign import ccall unsafe "cairo-xlib.h cairo_xlib_surface_create"
|
||||
xlibSurfaceCreate :: Display -> Drawable -> Visual -> CInt -> CInt -> IO (Ptr Surface)
|
||||
|
||||
createXlibSurface :: Display -> Drawable -> Visual -> CInt -> CInt -> IO Surface
|
||||
createXlibSurface dpy drawable visual width height = do
|
||||
surfacePtr <- xlibSurfaceCreate dpy drawable visual width height
|
||||
surface <- mkSurface surfacePtr
|
||||
manageSurface surface
|
||||
return surface
|
Reference in a new issue