{-# LINE 1 "Graphics/X11/Xinerama.hsc" #-}
--------------------------------------------------------------------
-- |
-- Module    : Graphics.X11.Xinerama
-- Copyright : (c) Haskell.org, 2007
-- License   : BSD3
--
-- Maintainer: Don Stewart <dons@galois.com>
-- Stability : provisional
-- Portability: portable
--
--------------------------------------------------------------------
--
-- Interface to Xinerama API
--

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 Graphics.X11.Xlib.Internal
import Control.Monad

-- | Representation of the XineramaScreenInfo struct
data XineramaScreenInfo = XineramaScreenInfo
                          { XineramaScreenInfo -> CInt
xsi_screen_number :: !CInt,
                            XineramaScreenInfo -> CShort
xsi_x_org         :: !CShort,
                            XineramaScreenInfo -> CShort
xsi_y_org         :: !CShort,
                            XineramaScreenInfo -> CShort
xsi_width         :: !CShort,
                            XineramaScreenInfo -> CShort
xsi_height        :: !CShort }
                            deriving (Int -> XineramaScreenInfo -> ShowS
[XineramaScreenInfo] -> ShowS
XineramaScreenInfo -> String
(Int -> XineramaScreenInfo -> ShowS)
-> (XineramaScreenInfo -> String)
-> ([XineramaScreenInfo] -> ShowS)
-> Show XineramaScreenInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XineramaScreenInfo] -> ShowS
$cshowList :: [XineramaScreenInfo] -> ShowS
show :: XineramaScreenInfo -> String
$cshow :: XineramaScreenInfo -> String
showsPrec :: Int -> XineramaScreenInfo -> ShowS
$cshowsPrec :: Int -> XineramaScreenInfo -> ShowS
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 :: Display -> IO [Rectangle]
getScreenInfo Display
dpy = do
    Maybe [XineramaScreenInfo]
mxs <- Display -> IO (Maybe [XineramaScreenInfo])
xineramaQueryScreens Display
dpy
    case Maybe [XineramaScreenInfo]
mxs of
        Just [XineramaScreenInfo]
xs -> [Rectangle] -> IO [Rectangle]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Rectangle] -> IO [Rectangle])
-> ([XineramaScreenInfo] -> [Rectangle])
-> [XineramaScreenInfo]
-> IO [Rectangle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XineramaScreenInfo -> Rectangle)
-> [XineramaScreenInfo] -> [Rectangle]
forall a b. (a -> b) -> [a] -> [b]
map XineramaScreenInfo -> Rectangle
xsiToRect ([XineramaScreenInfo] -> IO [Rectangle])
-> [XineramaScreenInfo] -> IO [Rectangle]
forall a b. (a -> b) -> a -> b
$ [XineramaScreenInfo]
xs
        Maybe [XineramaScreenInfo]
Nothing -> do
            WindowAttributes
wa <- Display -> Window -> IO WindowAttributes
getWindowAttributes Display
dpy (Display -> Window
defaultRootWindow Display
dpy)
            [Rectangle] -> IO [Rectangle]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Rectangle] -> IO [Rectangle]) -> [Rectangle] -> IO [Rectangle]
forall a b. (a -> b) -> a -> b
$ [Rectangle :: Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle
                        { rect_x :: Position
rect_x      = CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Position) -> CInt -> Position
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa
                        , rect_y :: Position
rect_y      = CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Position) -> CInt -> Position
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
wa
                        , rect_width :: Dimension
rect_width  = CInt -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Dimension) -> CInt -> Dimension
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_width WindowAttributes
wa
                        , rect_height :: Dimension
rect_height = CInt -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Dimension) -> CInt -> Dimension
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_height WindowAttributes
wa }]
 where
    xsiToRect :: XineramaScreenInfo -> Rectangle
xsiToRect XineramaScreenInfo
xsi = Rectangle :: Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle
                    { rect_x :: Position
rect_x        = CShort -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort -> Position) -> CShort -> Position
forall a b. (a -> b) -> a -> b
$ XineramaScreenInfo -> CShort
xsi_x_org XineramaScreenInfo
xsi
                    , rect_y :: Position
rect_y        = CShort -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort -> Position) -> CShort -> Position
forall a b. (a -> b) -> a -> b
$ XineramaScreenInfo -> CShort
xsi_y_org XineramaScreenInfo
xsi
                    , rect_width :: Dimension
rect_width    = CShort -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort -> Dimension) -> CShort -> Dimension
forall a b. (a -> b) -> a -> b
$ XineramaScreenInfo -> CShort
xsi_width XineramaScreenInfo
xsi
                    , rect_height :: Dimension
rect_height   = CShort -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort -> Dimension) -> CShort -> Dimension
forall a b. (a -> b) -> a -> b
$ XineramaScreenInfo -> CShort
xsi_height XineramaScreenInfo
xsi
                    }


{-# LINE 68 "Graphics/X11/Xinerama.hsc" #-}
-- We have Xinerama, so the library will actually work
compiledWithXinerama :: Bool
compiledWithXinerama :: Bool
compiledWithXinerama = Bool
True



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

  poke :: Ptr XineramaScreenInfo -> XineramaScreenInfo -> IO ()
poke Ptr XineramaScreenInfo
p XineramaScreenInfo
xsi = do
    (\Ptr XineramaScreenInfo
hsc_ptr -> Ptr XineramaScreenInfo -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr XineramaScreenInfo
hsc_ptr Int
0) Ptr XineramaScreenInfo
p (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ XineramaScreenInfo -> CInt
xsi_screen_number XineramaScreenInfo
xsi
{-# LINE 81 "Graphics/X11/Xinerama.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) p $ xsi_x_org xsi
{-# LINE 82 "Graphics/X11/Xinerama.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 6) p $ xsi_y_org xsi
{-# LINE 83 "Graphics/X11/Xinerama.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8) p $ xsi_width xsi
{-# LINE 84 "Graphics/X11/Xinerama.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 10) p $ xsi_height xsi
{-# LINE 85 "Graphics/X11/Xinerama.hsc" #-}

  peek :: Ptr XineramaScreenInfo -> IO XineramaScreenInfo
peek Ptr XineramaScreenInfo
p = (CInt
 -> CShort -> CShort -> CShort -> CShort -> XineramaScreenInfo)
-> IO
     (CInt
      -> CShort -> CShort -> CShort -> CShort -> XineramaScreenInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return CInt -> CShort -> CShort -> CShort -> CShort -> XineramaScreenInfo
XineramaScreenInfo
              IO
  (CInt
   -> CShort -> CShort -> CShort -> CShort -> XineramaScreenInfo)
-> IO CInt
-> IO (CShort -> CShort -> CShort -> CShort -> XineramaScreenInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ((\Ptr XineramaScreenInfo
hsc_ptr -> Ptr XineramaScreenInfo -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XineramaScreenInfo
hsc_ptr Int
0) Ptr XineramaScreenInfo
p)
{-# LINE 88 "Graphics/X11/Xinerama.hsc" #-}
              IO (CShort -> CShort -> CShort -> CShort -> XineramaScreenInfo)
-> IO CShort
-> IO (CShort -> CShort -> CShort -> XineramaScreenInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ((\Ptr XineramaScreenInfo
hsc_ptr -> Ptr XineramaScreenInfo -> Int -> IO CShort
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XineramaScreenInfo
hsc_ptr Int
4) Ptr XineramaScreenInfo
p)
{-# LINE 89 "Graphics/X11/Xinerama.hsc" #-}
              IO (CShort -> CShort -> CShort -> XineramaScreenInfo)
-> IO CShort -> IO (CShort -> CShort -> XineramaScreenInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ((\Ptr XineramaScreenInfo
hsc_ptr -> Ptr XineramaScreenInfo -> Int -> IO CShort
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XineramaScreenInfo
hsc_ptr Int
6) Ptr XineramaScreenInfo
p)
{-# LINE 90 "Graphics/X11/Xinerama.hsc" #-}
              IO (CShort -> CShort -> XineramaScreenInfo)
-> IO CShort -> IO (CShort -> XineramaScreenInfo)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ((\Ptr XineramaScreenInfo
hsc_ptr -> Ptr XineramaScreenInfo -> Int -> IO CShort
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XineramaScreenInfo
hsc_ptr Int
8) Ptr XineramaScreenInfo
p)
{-# LINE 91 "Graphics/X11/Xinerama.hsc" #-}
              IO (CShort -> XineramaScreenInfo)
-> IO CShort -> IO XineramaScreenInfo
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ((\Ptr XineramaScreenInfo
hsc_ptr -> Ptr XineramaScreenInfo -> Int -> IO CShort
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XineramaScreenInfo
hsc_ptr Int
10) Ptr XineramaScreenInfo
p)
{-# LINE 92 "Graphics/X11/Xinerama.hsc" #-}

foreign import ccall "XineramaIsActive"
  xineramaIsActive :: Display -> IO Bool

xineramaQueryExtension :: Display -> IO (Maybe (CInt, CInt))
xineramaQueryExtension :: Display -> IO (Maybe (CInt, CInt))
xineramaQueryExtension Display
dpy = (Ptr CInt -> Ptr CInt -> IO Bool)
-> (Bool -> CInt -> CInt -> Maybe (CInt, CInt))
-> IO (Maybe (CInt, CInt))
forall a b c d.
(Storable a, Storable b) =>
(Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d
wrapPtr2 (Display -> Ptr CInt -> Ptr CInt -> IO Bool
cXineramaQueryExtension Display
dpy) Bool -> CInt -> CInt -> Maybe (CInt, CInt)
forall {a} {a} {a} {b}.
(Integral a, Integral a, Num a, Num b) =>
Bool -> a -> a -> Maybe (a, b)
go
  where go :: Bool -> a -> a -> Maybe (a, b)
go Bool
False a
_ a
_                = Maybe (a, b)
forall a. Maybe a
Nothing
        go Bool
True a
eventbase a
errorbase = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
eventbase, a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
errorbase)

xineramaQueryVersion :: Display -> IO (Maybe (CInt, CInt))
xineramaQueryVersion :: Display -> IO (Maybe (CInt, CInt))
xineramaQueryVersion Display
dpy = (Ptr CInt -> Ptr CInt -> IO Bool)
-> (Bool -> CInt -> CInt -> Maybe (CInt, CInt))
-> IO (Maybe (CInt, CInt))
forall a b c d.
(Storable a, Storable b) =>
(Ptr a -> Ptr b -> IO c) -> (c -> a -> b -> d) -> IO d
wrapPtr2 (Display -> Ptr CInt -> Ptr CInt -> IO Bool
cXineramaQueryVersion Display
dpy) Bool -> CInt -> CInt -> Maybe (CInt, CInt)
forall {a} {a} {a} {b}.
(Integral a, Integral a, Num a, Num b) =>
Bool -> a -> a -> Maybe (a, b)
go
  where go :: Bool -> a -> a -> Maybe (a, b)
go Bool
False a
_ a
_        = Maybe (a, b)
forall a. Maybe a
Nothing
        go Bool
True a
major a
minor = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
major, a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
minor)

xineramaQueryScreens :: Display -> IO (Maybe [XineramaScreenInfo])
xineramaQueryScreens :: Display -> IO (Maybe [XineramaScreenInfo])
xineramaQueryScreens Display
dpy =
  (Pool -> IO (Maybe [XineramaScreenInfo]))
-> IO (Maybe [XineramaScreenInfo])
forall b. (Pool -> IO b) -> IO b
withPool ((Pool -> IO (Maybe [XineramaScreenInfo]))
 -> IO (Maybe [XineramaScreenInfo]))
-> (Pool -> IO (Maybe [XineramaScreenInfo]))
-> IO (Maybe [XineramaScreenInfo])
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> do Ptr CInt
intp <- Pool -> IO (Ptr CInt)
forall a. Storable a => Pool -> IO (Ptr a)
pooledMalloc Pool
pool
                         Ptr XineramaScreenInfo
p <- Display -> Ptr CInt -> IO (Ptr XineramaScreenInfo)
cXineramaQueryScreens Display
dpy Ptr CInt
intp
                         if Ptr XineramaScreenInfo
p Ptr XineramaScreenInfo -> Ptr XineramaScreenInfo -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr XineramaScreenInfo
forall a. Ptr a
nullPtr
                            then Maybe [XineramaScreenInfo] -> IO (Maybe [XineramaScreenInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [XineramaScreenInfo]
forall a. Maybe a
Nothing
                            else do CInt
nscreens <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
intp
                                    [XineramaScreenInfo]
screens <- Int -> Ptr XineramaScreenInfo -> IO [XineramaScreenInfo]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nscreens) Ptr XineramaScreenInfo
p
                                    CInt
_ <- Ptr XineramaScreenInfo -> IO CInt
forall a. Ptr a -> IO CInt
xFree Ptr XineramaScreenInfo
p
                                    Maybe [XineramaScreenInfo] -> IO (Maybe [XineramaScreenInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return ([XineramaScreenInfo] -> Maybe [XineramaScreenInfo]
forall a. a -> Maybe a
Just [XineramaScreenInfo]
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)

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


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