{-# INCLUDE <config.h> #-}
{-# INCLUDE <X11/Xlib.h> #-}
{-# INCLUDE <X11/extensions/Xinerama.h> #-}
{-# LINE 1 "Graphics/X11/Xinerama.hsc" #-}
-- | Interface to Xinerama API
{-# LINE 2 "Graphics/X11/Xinerama.hsc" #-}
module Graphics.X11.Xinerama
  (XineramaScreenInfo(..), 
   xineramaIsActive, 
   xineramaQueryExtension, 
   xineramaQueryVersion, 
   xineramaQueryScreens,
   getScreenInfo) where


{-# LINE 11 "Graphics/X11/Xinerama.hsc" #-}

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

-- | Representation of the XineramaScreenInfo struct
data XineramaScreenInfo = XineramaScreenInfo 
                          { xsi_screen_number :: CInt,
                            xsi_x_org         :: CShort,
                            xsi_y_org         :: CShort,
                            xsi_width         :: CShort,
                            xsi_height        :: CShort }
                            deriving (Show)

-- | Wrapper around xineramaQueryScreens that fakes a single screen when
-- Xinerama is not active. This is the preferred interface to
-- Graphics.X11.Xinerama.
getScreenInfo :: Display -> IO [Rectangle]
getScreenInfo dpy = maybe [singleScreen] (map xsiToRect) `liftM` xineramaQueryScreens dpy
    where dflt = defaultScreen dpy
          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
                        }
          singleScreen = Rectangle
                       { rect_x      = 0 
                       , rect_y      = 0 
                       , rect_width  = fromIntegral $ displayWidth dpy dflt
                       , rect_height = fromIntegral $ displayHeight dpy dflt
                       }


{-# LINE 46 "Graphics/X11/Xinerama.hsc" #-}
-- We have Xinerama, so the library will actually work

-- for XFree() (already included from Xinerama.h, but I don't know if I can count on that.)

{-# LINE 50 "Graphics/X11/Xinerama.hsc" #-}


{-# LINE 52 "Graphics/X11/Xinerama.hsc" #-}

instance Storable XineramaScreenInfo where
  sizeOf _ = (12)
{-# LINE 55 "Graphics/X11/Xinerama.hsc" #-}
  -- FIXME: Is this right?
  alignment _ = alignment (undefined :: CInt)

  poke p xsi = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 0) p $ xsi_screen_number xsi
{-# LINE 60 "Graphics/X11/Xinerama.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) p $ xsi_x_org xsi
{-# LINE 61 "Graphics/X11/Xinerama.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 6) p $ xsi_y_org xsi
{-# LINE 62 "Graphics/X11/Xinerama.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8) p $ xsi_width xsi
{-# LINE 63 "Graphics/X11/Xinerama.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 10) p $ xsi_height xsi
{-# LINE 64 "Graphics/X11/Xinerama.hsc" #-}

  peek p = return XineramaScreenInfo
              `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 0) p)
{-# LINE 67 "Graphics/X11/Xinerama.hsc" #-}
              `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 4) p)
{-# LINE 68 "Graphics/X11/Xinerama.hsc" #-}
              `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 6) p)
{-# LINE 69 "Graphics/X11/Xinerama.hsc" #-}
              `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 8) p)
{-# LINE 70 "Graphics/X11/Xinerama.hsc" #-}
              `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 10) p)
{-# LINE 71 "Graphics/X11/Xinerama.hsc" #-}

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)


{-# LINE 130 "Graphics/X11/Xinerama.hsc" #-}