{-# LINE 1 "Graphics/X11/Xshape.hsc" #-}
--------------------------------------------------------------------
{-# LINE 2 "Graphics/X11/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



{-# LINE 184 "Graphics/X11/Xshape.hsc" #-}

-- 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)


{-# LINE 224 "Graphics/X11/Xshape.hsc" #-}