Xshape.hsc

--------------------------------------------------------------------
-- |
-- Module    : Graphics.X11.Xshape
-- Copyright : (c) Haskell.org, 2009
-- License   : BSD3
--
-- Maintainer: Ewan Higgs <ewan_higgs@yahoo.co.uk>
-- Stability : unstable 
-- Portability: unportable 
--
--------------------------------------------------------------------
--
-- Interface to Xshape API
--

module Graphics.X11.Xshape( xshapeQueryExtension
                          , xshapeQueryVersion
                          , xshapeCombineRegion 
                          , xshapeCombineRectangles 
                          , xshapeCombineMask 
                          , xshapeCombineShape 
                          , xshapeOffsetShape 
                          , xshapeQueryExtents 
                          , xshapeSelectInput 
                          , xshapeInputSelected
             --             , xshapeGetRectangles
                          , shapeQueryVersion
                          , shapeRectangles
                          , shapeMask
                          , shapeCombine
                          , shapeOffset
                          , shapeQueryExtents
                          , shapeSelectInput
                          , shapeInputSelected
                          , shapeGetRectangles
                          , shapeSet
                          , shapeUnion
                          , shapeIntersect
                          , shapeSubtract
                          , shapeInvert
                          , shapeBounding
                          , shapeClip
                          , shapeInput
                          , shapeNotifyMask
                          , shapeNotify
                          , shapeNumberEvents
) where

import Foreign
import Foreign.C.Types
import Graphics.X11.Xlib
import Control.Monad

data XShapeEvent = XShapeEvent
                 { xse_type       :: CInt
                 , xse_serial     :: CUInt
                 , xse_send_event :: Bool
                 , xse_display    :: Display
                 , xse_window     :: Window
                 , xse_kind       :: CInt
                 , xse_x          :: CInt
                 , xse_y          :: CInt
                 , xse_width      :: CUInt
                 , xse_height     :: CUInt
                 , xse_time       :: Time
                 , xse_shaped     :: Bool 
                 }
shapeQueryVersion  :: CInt
shapeQueryVersion   = 0
shapeRectangles    :: CInt 
shapeRectangles     = 1
shapeMask          :: CInt 
shapeMask           = 2
shapeCombine       :: CInt 
shapeCombine        = 3
shapeOffset        :: CInt 
shapeOffset         = 4
shapeQueryExtents  :: CInt
shapeQueryExtents   = 5
shapeSelectInput   :: CInt
shapeSelectInput    = 6
shapeInputSelected :: CInt
shapeInputSelected  = 7
shapeGetRectangles :: CInt
shapeGetRectangles  = 8

shapeSet       :: CInt
shapeSet        = 0
shapeUnion     :: CInt
shapeUnion      = 1
shapeIntersect :: CInt
shapeIntersect  = 2
shapeSubtract  :: CInt
shapeSubtract   = 3
shapeInvert    :: CInt
shapeInvert     = 4

shapeBounding :: CInt
shapeBounding  = 0
shapeClip     :: CInt
shapeClip      = 1
shapeInput    :: CInt
shapeInput     = 2

shapeNotifyMask :: Int
shapeNotifyMask  = 1 `shiftL` 0
shapeNotify     :: Int
shapeNotify      = 0

shapeNumberEvents :: Int
shapeNumberEvents  = shapeNotify + 1


#ifdef HAVE_X11_EXTENSIONS_XSHAPE_H

-- We have Xinerama, so the library will actually work
compiledWithXshape :: Bool
compiledWithXshape = True

-- for XFree() (already included from Xdamage.h, but I don't know if I can count on that.)
#include <X11/Xlib.h>

#include <X11/extensions/shape.h>

xshapeQueryExtension :: Display -> IO (Maybe (CInt, CInt))
xshapeQueryExtension dpy = wrapPtr2 (cXshapeQueryExtension dpy) go
  where go False _ _                = Nothing
        go True eventbase errorbase = Just (fromIntegral eventbase, fromIntegral errorbase)

xshapeQueryVersion :: Display -> IO (Maybe (CInt, CInt))
xshapeQueryVersion dpy = wrapPtr2 (cXshapeQueryVersion dpy) go
  where go False _ _        = Nothing
        go True major minor = Just (fromIntegral major, fromIntegral minor)

foreign import ccall "XShapeQueryExtension"
  cXshapeQueryExtension :: Display -> Ptr CInt -> Ptr CInt -> IO Bool

foreign import ccall "XShapeQueryVersion"
  cXshapeQueryVersion :: Display -> Ptr CInt -> Ptr CInt -> IO Bool

foreign import ccall "XShapeCombineRegion"
  xshapeCombineRegion :: Display -> Window -> CInt -> CInt -> CInt -> Ptr Region -> CInt -> IO()

foreign import ccall "XShapeCombineRectangles"
  xshapeCombineRectangles :: Display -> Window -> CInt -> CInt -> CInt -> Ptr Rectangle -> CInt -> CInt -> CInt -> IO()

foreign import ccall "XShapeCombineMask"
  xshapeCombineMask :: Display -> Window -> CInt -> CInt -> CInt -> Pixmap -> CInt -> IO ()

foreign import ccall "XShapeCombineShape"
  xshapeCombineShape :: Display -> Window -> CInt -> CInt -> CInt -> Window -> CInt -> CInt -> IO ()


foreign import ccall "XShapeOffsetShape"
  xshapeOffsetShape :: Display -> Window -> CInt -> CInt -> CInt -> IO ()

foreign import ccall "XShapeQueryExtents"
  xshapeQueryExtents :: Display -> Window -> CInt -> CInt -> CUInt -> CUInt -> Bool -> CInt -> CInt -> CUInt -> CUInt -> IO ()

foreign import ccall "XShapeSelectInput"
  xshapeSelectInput :: Display -> Window -> CUInt -> IO()

foreign import ccall "XShapeInputSelected"
  xshapeInputSelected :: Display -> Window -> IO(CUInt)

  -- May leak the returned Rectangle; ask for help here
foreign import ccall "XShapeGetRectangles"
  xshapeGetRectangles :: Display -> Window -> CInt -> Ptr CInt -> Ptr CInt -> IO(Ptr Rectangle)

foreign import ccall "XFree"
  cXFree :: Ptr a -> IO CInt


wrapPtr2 :: (Storable a, Storable b) => (Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d
wrapPtr2 cfun f =
  withPool $ \pool -> do aptr <- pooledMalloc pool
                         bptr <- pooledMalloc pool
                         ret <- cfun aptr bptr
                         a <- peek aptr
                         b <- peek bptr
                         return (f ret a b)

#else

-- No Xshape, but if we fake a non-active Xdamage interface, we can still have
-- an active interface
compiledWithXshape :: Bool
compiledWithXshape = False

xshapeQueryExtension :: Display -> IO (Maybe (CInt, CInt))
xshapeQueryExtension _  = return Nothing

xshapeQueryVersion :: Display -> IO (Maybe (CInt, CInt))
xshapeQueryVersion _ = return Nothing

xshapeCombineRegion :: Display -> Window -> CInt -> CInt -> CInt -> Region -> CInt -> IO()
xshapeCombineRegion _ _ _ _ _ _ _ = return ()

xshapeCombineRectangles :: Display -> Window -> CInt -> CInt -> CInt -> Rectangle -> CInt -> CInt -> CInt -> IO()
xshapeCombineRectangles _ _ _ _ _ _ _ _ _ = return ()

xshapeCombineMask :: Display -> Window -> CInt -> CInt -> CInt -> Pixmap -> CInt -> IO ()
xshapeCombineMask _ _ _ _ _ _ _ = return ()

xshapeCombineShape :: Display -> Window -> CInt -> CInt -> CInt -> Window -> CInt -> CInt -> IO ()
xshapeCombineShape _ _ _ _ _ _ _ _ = return ()

xshapeOffsetShape :: Display -> Window -> CInt -> CInt -> CInt -> IO ()
xshapeOffsetShape _ _ _ _ _ = return ()

xshapeQueryExtents :: Display -> Window -> CInt -> CInt -> CUInt -> CUInt -> Bool -> CInt -> CInt -> CUInt -> CUInt -> IO ()
xshapeQueryExtents _ _ _ _ _ _ _ _ _ _ _ = return ()

xshapeSelectInput :: Display -> Window -> CUInt -> IO()
xshapeSelectInput  _ _ _ = return ()

xshapeInputSelected :: Display -> Window -> IO(CUInt)
xshapeInputSelected _ _ = return 0

-- xshapeGetRectangles :: Display -> Window -> CInt -> Ptr CInt -> Ptr CInt -> IO(Ptr Rectangle)
-- xshapeGetRectangles  _ _ _ _ _ = return $ Ptr (Rectangle 0 0 0 0)

#endif