-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.X11.Xlib.Window
-- Copyright   :  (c) Alastair Reid, 1999-2003
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- A collection of FFI declarations for interfacing with Xlib Windows.
--
-----------------------------------------------------------------------------

module Graphics.X11.Xlib.Window(
        storeName,
        createSimpleWindow,
        createWindow,
        translateCoordinates,
        moveResizeWindow,
        resizeWindow,
        moveWindow,
        reparentWindow,
        mapSubwindows,
        unmapSubwindows,
        mapWindow,
        lowerWindow,
        raiseWindow,
        circulateSubwindowsDown,
        circulateSubwindowsUp,
        circulateSubwindows,
        iconifyWindow,
        withdrawWindow,
        destroyWindow,
        destroySubwindows,
        setWindowBorder,
        setWindowBorderPixmap,
        setWindowBorderWidth,
        setWindowBackground,
        setWindowBackgroundPixmap,
        setWindowColormap,
        addToSaveSet,
        removeFromSaveSet,
        changeSaveSet,
        clearWindow,
        clearArea,
        restackWindows,

        ) where

import Graphics.X11.Types
import Graphics.X11.Xlib.Types

import Foreign
import Foreign.C

----------------------------------------------------------------
-- Windows
----------------------------------------------------------------

-- | interface to the X11 library function @XStoreName()@.
storeName :: Display -> Window -> String -> IO ()
storeName :: Display -> Window -> String -> IO ()
storeName Display
display Window
window String
name =
        String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
c_name ->
        Display -> Window -> CString -> IO ()
xStoreName Display
display Window
window CString
c_name
foreign import ccall unsafe "HsXlib.h XStoreName"
        xStoreName :: Display -> Window -> CString -> IO ()

-- | interface to the X11 library function @XCreateSimpleWindow()@.
foreign import ccall unsafe "HsXlib.h XCreateSimpleWindow"
        createSimpleWindow :: Display -> Window -> Position -> Position ->
                Dimension -> Dimension -> CInt -> Pixel -> Pixel -> IO Window

-- | interface to the X11 library function @XCreateWindow()@.
foreign import ccall unsafe "HsXlib.h XCreateWindow"
        createWindow :: Display -> Window -> Position -> Position ->
                Dimension -> Dimension -> CInt -> CInt -> WindowClass ->
                Visual -> AttributeMask -> Ptr SetWindowAttributes -> IO Window

----------------------------------------------------------------

--ToDo: find an effective way to use Maybes

-- | interface to the X11 library function @XTranslateCoordinates()@.
translateCoordinates :: Display -> Window -> Window -> Position -> Position ->
        IO (Bool,Position,Position,Window)
translateCoordinates :: Display
-> Window
-> Window
-> Position
-> Position
-> IO (Bool, Position, Position, Window)
translateCoordinates Display
display Window
src_w Window
dest_w Position
src_x Position
src_y =
        (Ptr Position -> IO (Bool, Position, Position, Window))
-> IO (Bool, Position, Position, Window)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Position -> IO (Bool, Position, Position, Window))
 -> IO (Bool, Position, Position, Window))
-> (Ptr Position -> IO (Bool, Position, Position, Window))
-> IO (Bool, Position, Position, Window)
forall a b. (a -> b) -> a -> b
$ \ Ptr Position
dest_x_return ->
        (Ptr Position -> IO (Bool, Position, Position, Window))
-> IO (Bool, Position, Position, Window)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Position -> IO (Bool, Position, Position, Window))
 -> IO (Bool, Position, Position, Window))
-> (Ptr Position -> IO (Bool, Position, Position, Window))
-> IO (Bool, Position, Position, Window)
forall a b. (a -> b) -> a -> b
$ \ Ptr Position
dest_y_return ->
        (Ptr Window -> IO (Bool, Position, Position, Window))
-> IO (Bool, Position, Position, Window)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Window -> IO (Bool, Position, Position, Window))
 -> IO (Bool, Position, Position, Window))
-> (Ptr Window -> IO (Bool, Position, Position, Window))
-> IO (Bool, Position, Position, Window)
forall a b. (a -> b) -> a -> b
$ \ Ptr Window
child_return -> do
        Bool
res <- Display
-> Window
-> Window
-> Position
-> Position
-> Ptr Position
-> Ptr Position
-> Ptr Window
-> IO Bool
xTranslateCoordinates Display
display Window
src_w Window
dest_w Position
src_x Position
src_y
                        Ptr Position
dest_x_return Ptr Position
dest_y_return Ptr Window
child_return
        Position
dest_x <- Ptr Position -> IO Position
forall a. Storable a => Ptr a -> IO a
peek Ptr Position
dest_x_return
        Position
dest_y <- Ptr Position -> IO Position
forall a. Storable a => Ptr a -> IO a
peek Ptr Position
dest_y_return
        Window
child  <- Ptr Window -> IO Window
forall a. Storable a => Ptr a -> IO a
peek Ptr Window
child_return
        (Bool, Position, Position, Window)
-> IO (Bool, Position, Position, Window)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
res, Position
dest_x, Position
dest_y, Window
child)
foreign import ccall unsafe "HsXlib.h XTranslateCoordinates"
        xTranslateCoordinates :: Display -> Window -> Window ->
                Position -> Position ->
                Ptr Position -> Ptr Position -> Ptr Window -> IO Bool

-- | interface to the X11 library function @XMoveResizeWindow()@.
foreign import ccall unsafe "HsXlib.h XMoveResizeWindow"
        moveResizeWindow             :: Display -> Window -> Position  -> Position  -> Dimension -> Dimension -> IO ()

-- | interface to the X11 library function @XResizeWindow()@.
foreign import ccall unsafe "HsXlib.h XResizeWindow"
        resizeWindow                 :: Display -> Window -> Dimension -> Dimension -> IO ()

-- | interface to the X11 library function @XMoveWindow()@.
foreign import ccall unsafe "HsXlib.h XMoveWindow"
        moveWindow                   :: Display -> Window -> Position  -> Position  -> IO ()

-- | interface to the X11 library function @XReparentWindow()@.
foreign import ccall unsafe "HsXlib.h XReparentWindow"
        reparentWindow               :: Display -> Window -> Window -> Position -> Position  -> IO ()

-- | interface to the X11 library function @XMapSubwindows()@.
foreign import ccall unsafe "HsXlib.h XMapSubwindows"
        mapSubwindows                :: Display -> Window -> IO ()

-- | interface to the X11 library function @XUnmapSubwindows()@.
foreign import ccall unsafe "HsXlib.h XUnmapSubwindows"
        unmapSubwindows              :: Display -> Window -> IO ()

-- | interface to the X11 library function @XMapWindow()@.
foreign import ccall unsafe "HsXlib.h XMapWindow"
        mapWindow                    :: Display -> Window -> IO ()
-- Disnae exist: %fun XUnmapWindows                :: Display -> Window -> IO ()
-- Disnae exist: %fun XMapRaisedWindow             :: Display -> Window -> IO ()

-- | interface to the X11 library function @XLowerWindow()@.
foreign import ccall unsafe "HsXlib.h XLowerWindow"
        lowerWindow                  :: Display -> Window -> IO ()

-- | interface to the X11 library function @XRaiseWindow()@.
foreign import ccall unsafe "HsXlib.h XRaiseWindow"
        raiseWindow                  :: Display -> Window -> IO ()

-- | interface to the X11 library function @XCirculateSubwindowsDown()@.
foreign import ccall unsafe "HsXlib.h XCirculateSubwindowsDown"
        circulateSubwindowsDown      :: Display -> Window -> IO ()

-- | interface to the X11 library function @XCirculateSubwindowsUp()@.
foreign import ccall unsafe "HsXlib.h XCirculateSubwindowsUp"
        circulateSubwindowsUp        :: Display -> Window -> IO ()

-- | interface to the X11 library function @XCirculateSubwindows()@.
foreign import ccall unsafe "HsXlib.h XCirculateSubwindows"
        circulateSubwindows          :: Display -> Window -> CirculationDirection -> IO ()

-- | interface to the X11 library function @XIconifyWindow()@.
iconifyWindow  :: Display -> Window -> ScreenNumber -> IO ()
iconifyWindow :: Display -> Window -> ScreenNumber -> IO ()
iconifyWindow Display
display Window
window ScreenNumber
screenno =
        String -> IO CInt -> IO ()
throwIfZero String
"iconifyWindow"
                (Display -> Window -> ScreenNumber -> IO CInt
xIconifyWindow Display
display Window
window ScreenNumber
screenno)
foreign import ccall unsafe "HsXlib.h XIconifyWindow"
        xIconifyWindow  :: Display -> Window -> ScreenNumber -> IO Status

-- | interface to the X11 library function @XWithdrawWindow()@.
withdrawWindow :: Display -> Window -> ScreenNumber -> IO ()
withdrawWindow :: Display -> Window -> ScreenNumber -> IO ()
withdrawWindow Display
display Window
window ScreenNumber
screenno =
        String -> IO CInt -> IO ()
throwIfZero String
"withdrawWindow"
                (Display -> Window -> ScreenNumber -> IO CInt
xWithdrawWindow Display
display Window
window ScreenNumber
screenno)
foreign import ccall unsafe "HsXlib.h XWithdrawWindow"
        xWithdrawWindow :: Display -> Window -> ScreenNumber -> IO Status

-- | interface to the X11 library function @XDestroyWindow()@.
foreign import ccall unsafe "HsXlib.h XDestroyWindow"
        destroyWindow                :: Display -> Window -> IO ()

-- | interface to the X11 library function @XDestroySubwindows()@.
foreign import ccall unsafe "HsXlib.h XDestroySubwindows"
        destroySubwindows            :: Display -> Window -> IO ()

-- | interface to the X11 library function @XSetWindowBorder()@.
foreign import ccall unsafe "HsXlib.h XSetWindowBorder"
        setWindowBorder              :: Display -> Window -> Pixel     -> IO ()

-- | interface to the X11 library function @XSetWindowBorderPixmap()@.
foreign import ccall unsafe "HsXlib.h XSetWindowBorderPixmap"
        setWindowBorderPixmap        :: Display -> Window -> Pixmap    -> IO ()

-- | interface to the X11 library function @XSetWindowBorderWidth()@.
foreign import ccall unsafe "HsXlib.h XSetWindowBorderWidth"
        setWindowBorderWidth         :: Display -> Window -> Dimension -> IO ()

-- | interface to the X11 library function @XSetWindowBackground()@.
foreign import ccall unsafe "HsXlib.h XSetWindowBackground"
        setWindowBackground          :: Display -> Window -> Pixel     -> IO ()

-- | interface to the X11 library function @XSetWindowBackgroundPixmap()@.
foreign import ccall unsafe "HsXlib.h XSetWindowBackgroundPixmap"
        setWindowBackgroundPixmap    :: Display -> Window -> Pixmap    -> IO ()

-- | interface to the X11 library function @XSetWindowColormap()@.
foreign import ccall unsafe "HsXlib.h XSetWindowColormap"
        setWindowColormap            :: Display -> Window -> Colormap  -> IO ()

-- | interface to the X11 library function @XAddToSaveSet()@.
foreign import ccall unsafe "HsXlib.h XAddToSaveSet"
        addToSaveSet                 :: Display -> Window -> IO ()

-- | interface to the X11 library function @XRemoveFromSaveSet()@.
foreign import ccall unsafe "HsXlib.h XRemoveFromSaveSet"
        removeFromSaveSet            :: Display -> Window -> IO ()

-- | interface to the X11 library function @XChangeSaveSet()@.
foreign import ccall unsafe "HsXlib.h XChangeSaveSet"
        changeSaveSet                :: Display -> Window -> ChangeSaveSetMode -> IO ()

-- | interface to the X11 library function @XClearWindow()@.
foreign import ccall unsafe "HsXlib.h XClearWindow"
        clearWindow                  :: Display -> Window -> IO ()

-- | interface to the X11 library function @XClearArea()@.
foreign import ccall unsafe "HsXlib.h XClearArea"
        clearArea                    :: Display -> Window ->
                Position -> Position -> Dimension -> Dimension -> Bool -> IO ()

-- This is almost good enough - but doesn't call XFree
-- -- %errfun BadStatus XQueryTree :: Display -> Window -> IO (Window, Window, ListWindow) using err = XQueryTree(arg1,arg2,&res1,&res2,&res3,&res3_size)
-- %prim XQueryTree :: Display -> Window -> IO (Window, Window, ListWindow)
-- Window root_w, parent;
-- Int children_size;
-- Window *children;
-- Status r = XQueryTree(arg1,arg2,&root_w, &parent, &children, &children_size);
-- if (Success != r) { %failWith(BadStatus,r); }
-- %update(root_w,parent,children);
-- XFree(children);
-- return;

-- | interface to the X11 library function @XRestackWindows()@.
restackWindows :: Display -> [Window] -> IO ()
restackWindows :: Display -> [Window] -> IO ()
restackWindows Display
display [Window]
windows =
        [Window] -> (Ptr Window -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Window]
windows ((Ptr Window -> IO ()) -> IO ()) -> (Ptr Window -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Window
window_array ->
        Display -> Ptr Window -> CInt -> IO ()
xRestackWindows Display
display Ptr Window
window_array (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Window] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
windows))
foreign import ccall unsafe "HsXlib.h XRestackWindows"
        xRestackWindows :: Display -> Ptr Window -> CInt -> IO ()

-- ToDo: I want to be able to write this
-- -- %fun XListInstalledColormaps :: Display -> Window -> IO ListColormap using res1 = XListInstalledColormaps(arg1,arg2,&res1_size)
-- -- But I have to write this instead - need to add a notion of cleanup code!
-- %prim XListInstalledColormaps :: Display -> Window -> IO ListColormap
-- Int r_size;
-- Colormap* r = XListInstalledColormaps(arg1,arg2,&r_size);
-- %update(r);
-- XFree(r);
-- return;
--
-- -- Again, this is almost good enough
-- -- %errfun BadStatus XGetCommand :: Display -> Window -> IO ListString using err = XGetCommand(arg1,arg2,&res1,&res1_size)
-- -- but not quite
-- -- %prim XGetCommand :: Display -> Window -> IO ListString
-- --Int    argv_size;
-- --String *argv;
-- --Status r = XGetCommand(arg1,arg2,&argv,&argv_size);
-- --if (Success != r) { %failWith(BadStatus, r); }
-- -- %update(argv);
-- --XFreeStringList(argv);
-- --return;
--
-- -- %fun XSetCommand :: Display -> Window -> ListString -> IO ()            using XSetCommand(arg1,arg2,arg3,res3_size)
--
-- %errfun BadStatus XGetTransientForHint :: Display -> Window -> IO Window using err = XGetTransientForHint(arg1,arg2,&res1)
--
-- %fun XSetTransientForHint :: Display -> Window -> Window -> IO ()
--
-- -- XRotateWindowProperties omitted
-- -- XGetWindowProperty omitted
--
-- -- XGetWindowAttributes omitted
-- -- XChangeWindowAttributes omitted

----------------------------------------------------------------
-- End
----------------------------------------------------------------