module Graphics.X11.Xinerama
(XineramaScreenInfo(..),
xineramaIsActive,
xineramaQueryExtension,
xineramaQueryVersion,
xineramaQueryScreens,
compiledWithXinerama,
getScreenInfo) where
import Foreign
import Foreign.C.Types
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras (WindowAttributes(..), getWindowAttributes)
import Control.Monad
data XineramaScreenInfo = XineramaScreenInfo
{ xsi_screen_number :: CInt,
xsi_x_org :: CShort,
xsi_y_org :: CShort,
xsi_width :: CShort,
xsi_height :: CShort }
deriving (Show)
getScreenInfo :: Display -> IO [Rectangle]
getScreenInfo dpy = do
mxs <- xineramaQueryScreens dpy
case mxs of
Just xs -> return . map xsiToRect $ xs
Nothing -> do
wa <- getWindowAttributes dpy (defaultRootWindow dpy)
return $ [Rectangle
{ rect_x = fromIntegral $ wa_x wa
, rect_y = fromIntegral $ wa_y wa
, rect_width = fromIntegral $ wa_width wa
, rect_height = fromIntegral $ wa_height wa }]
where
xsiToRect xsi = Rectangle
{ rect_x = fromIntegral $ xsi_x_org xsi
, rect_y = fromIntegral $ xsi_y_org xsi
, rect_width = fromIntegral $ xsi_width xsi
, rect_height = fromIntegral $ xsi_height xsi
}
compiledWithXinerama :: Bool
compiledWithXinerama = True
instance Storable XineramaScreenInfo where
sizeOf _ = (12)
alignment _ = alignment (undefined :: CInt)
poke p xsi = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p $ xsi_screen_number xsi
(\hsc_ptr -> pokeByteOff hsc_ptr 4) p $ xsi_x_org xsi
(\hsc_ptr -> pokeByteOff hsc_ptr 6) p $ xsi_y_org xsi
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p $ xsi_width xsi
(\hsc_ptr -> pokeByteOff hsc_ptr 10) p $ xsi_height xsi
peek p = return XineramaScreenInfo
`ap` ((\hsc_ptr -> peekByteOff hsc_ptr 0) p)
`ap` ((\hsc_ptr -> peekByteOff hsc_ptr 4) p)
`ap` ((\hsc_ptr -> peekByteOff hsc_ptr 6) p)
`ap` ((\hsc_ptr -> peekByteOff hsc_ptr 8) p)
`ap` ((\hsc_ptr -> peekByteOff hsc_ptr 10) p)
foreign import ccall "XineramaIsActive"
xineramaIsActive :: Display -> IO Bool
xineramaQueryExtension :: Display -> IO (Maybe (CInt, CInt))
xineramaQueryExtension dpy = wrapPtr2 (cXineramaQueryExtension dpy) go
where go False _ _ = Nothing
go True eventbase errorbase = Just (fromIntegral eventbase, fromIntegral errorbase)
xineramaQueryVersion :: Display -> IO (Maybe (CInt, CInt))
xineramaQueryVersion dpy = wrapPtr2 (cXineramaQueryVersion dpy) go
where go False _ _ = Nothing
go True major minor = Just (fromIntegral major, fromIntegral minor)
xineramaQueryScreens :: Display -> IO (Maybe [XineramaScreenInfo])
xineramaQueryScreens dpy =
withPool $ \pool -> do intp <- pooledMalloc pool
p <- cXineramaQueryScreens dpy intp
if p == nullPtr
then return Nothing
else do nscreens <- peek intp
screens <- peekArray (fromIntegral nscreens) p
cXFree p
return (Just screens)
foreign import ccall "XineramaQueryExtension"
cXineramaQueryExtension :: Display -> Ptr CInt -> Ptr CInt -> IO Bool
foreign import ccall "XineramaQueryVersion"
cXineramaQueryVersion :: Display -> Ptr CInt -> Ptr CInt -> IO Bool
foreign import ccall "XineramaQueryScreens"
cXineramaQueryScreens :: Display -> Ptr CInt -> IO (Ptr XineramaScreenInfo)
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)