{-# INCLUDE <config.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 115 "Graphics/X11/Xinerama.hsc" #-}

-- No Xinerama, but if we fake a non-active Xinerama interface, "getScreenInfo"
-- will continue to work fine in the single-screen case.
xineramaIsActive :: Display -> IO Bool
xineramaIsActive _ = return False

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

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

xineramaQueryScreens :: Display -> IO (Maybe [XineramaScreenInfo])
xineramaQueryScreens _ = return Nothing

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