-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.X11.Xlib.Color
-- 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 Colors.
--
-----------------------------------------------------------------------------

module Graphics.X11.Xlib.Color(

        lookupColor,
        allocNamedColor,
        allocColor,
        parseColor,
        freeColors,
        storeColor,
        queryColor,
        queryColors,
        installColormap,
        uninstallColormap,
        copyColormapAndFree,
        createColormap,
        freeColormap,

        ) where

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

import Foreign
import Foreign.C

----------------------------------------------------------------
-- Color and Colormaps
----------------------------------------------------------------

-- | interface to the X11 library function @XLookupColor()@.
lookupColor :: Display -> Colormap -> String -> IO (Color, Color)
lookupColor :: Display -> Pixel -> String -> IO (Color, Color)
lookupColor Display
display Pixel
colormap String
color_name =
        String -> (CString -> IO (Color, Color)) -> IO (Color, Color)
forall a. String -> (CString -> IO a) -> IO a
withCString String
color_name ((CString -> IO (Color, Color)) -> IO (Color, Color))
-> (CString -> IO (Color, Color)) -> IO (Color, Color)
forall a b. (a -> b) -> a -> b
$ \CString
c_color_name ->
        (Ptr Color -> IO (Color, Color)) -> IO (Color, Color)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Color -> IO (Color, Color)) -> IO (Color, Color))
-> (Ptr Color -> IO (Color, Color)) -> IO (Color, Color)
forall a b. (a -> b) -> a -> b
$ \ Ptr Color
exact_def_return ->
        (Ptr Color -> IO (Color, Color)) -> IO (Color, Color)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Color -> IO (Color, Color)) -> IO (Color, Color))
-> (Ptr Color -> IO (Color, Color)) -> IO (Color, Color)
forall a b. (a -> b) -> a -> b
$ \ Ptr Color
screen_def_return -> do
        String -> IO CInt -> IO ()
throwIfZero String
"lookupColor" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
                Display -> Pixel -> CString -> Ptr Color -> Ptr Color -> IO CInt
xLookupColor Display
display Pixel
colormap CString
c_color_name
                        Ptr Color
exact_def_return Ptr Color
screen_def_return
        Color
exact_def <- Ptr Color -> IO Color
forall a. Storable a => Ptr a -> IO a
peek Ptr Color
exact_def_return
        Color
screen_def <- Ptr Color -> IO Color
forall a. Storable a => Ptr a -> IO a
peek Ptr Color
screen_def_return
        (Color, Color) -> IO (Color, Color)
forall (m :: * -> *) a. Monad m => a -> m a
return (Color
exact_def, Color
screen_def)

foreign import ccall unsafe "HsXlib.h XLookupColor"
        xLookupColor :: Display -> Colormap -> CString ->
                Ptr Color -> Ptr Color -> IO Status

-- TODO don't throw an exception.
-- | interface to the X11 library function @XAllocNamedColor()@.
allocNamedColor :: Display -> Colormap -> String -> IO (Color, Color)
allocNamedColor :: Display -> Pixel -> String -> IO (Color, Color)
allocNamedColor Display
display Pixel
colormap String
color_name =
        String -> (CString -> IO (Color, Color)) -> IO (Color, Color)
forall a. String -> (CString -> IO a) -> IO a
withCString String
color_name ((CString -> IO (Color, Color)) -> IO (Color, Color))
-> (CString -> IO (Color, Color)) -> IO (Color, Color)
forall a b. (a -> b) -> a -> b
$ \CString
c_color_name ->
        (Ptr Color -> IO (Color, Color)) -> IO (Color, Color)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Color -> IO (Color, Color)) -> IO (Color, Color))
-> (Ptr Color -> IO (Color, Color)) -> IO (Color, Color)
forall a b. (a -> b) -> a -> b
$ \ Ptr Color
exact_def_return ->
        (Ptr Color -> IO (Color, Color)) -> IO (Color, Color)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Color -> IO (Color, Color)) -> IO (Color, Color))
-> (Ptr Color -> IO (Color, Color)) -> IO (Color, Color)
forall a b. (a -> b) -> a -> b
$ \ Ptr Color
screen_def_return -> do
        String -> IO CInt -> IO ()
throwIfZero String
"allocNamedColor" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
                Display -> Pixel -> CString -> Ptr Color -> Ptr Color -> IO CInt
xAllocNamedColor Display
display Pixel
colormap CString
c_color_name
                        Ptr Color
exact_def_return Ptr Color
screen_def_return
        Color
exact_def <- Ptr Color -> IO Color
forall a. Storable a => Ptr a -> IO a
peek Ptr Color
exact_def_return
        Color
screen_def <- Ptr Color -> IO Color
forall a. Storable a => Ptr a -> IO a
peek Ptr Color
screen_def_return
        (Color, Color) -> IO (Color, Color)
forall (m :: * -> *) a. Monad m => a -> m a
return (Color
exact_def, Color
screen_def)

foreign import ccall unsafe "HsXlib.h XAllocNamedColor"
        xAllocNamedColor :: Display -> Colormap -> CString ->
                Ptr Color -> Ptr Color -> IO Status

-- | interface to the X11 library function @XAllocColor()@.
allocColor :: Display -> Colormap -> Color -> IO Color
allocColor :: Display -> Pixel -> Color -> IO Color
allocColor Display
display Pixel
colormap Color
color =
        Color -> (Ptr Color -> IO Color) -> IO Color
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color ((Ptr Color -> IO Color) -> IO Color)
-> (Ptr Color -> IO Color) -> IO Color
forall a b. (a -> b) -> a -> b
$ \ Ptr Color
color_ptr -> do
        String -> IO CInt -> IO ()
throwIfZero String
"allocColor" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
                Display -> Pixel -> Ptr Color -> IO CInt
xAllocColor Display
display Pixel
colormap Ptr Color
color_ptr
        Ptr Color -> IO Color
forall a. Storable a => Ptr a -> IO a
peek Ptr Color
color_ptr

foreign import ccall unsafe "HsXlib.h XAllocColor"
        xAllocColor :: Display -> Colormap -> Ptr Color -> IO Status

-- | interface to the X11 library function @XParseColor()@.
parseColor :: Display -> Colormap -> String -> IO Color
parseColor :: Display -> Pixel -> String -> IO Color
parseColor Display
display Pixel
colormap String
color_spec =
        String -> (CString -> IO Color) -> IO Color
forall a. String -> (CString -> IO a) -> IO a
withCString String
color_spec ((CString -> IO Color) -> IO Color)
-> (CString -> IO Color) -> IO Color
forall a b. (a -> b) -> a -> b
$ \ CString
spec ->
        (Ptr Color -> IO Color) -> IO Color
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Color -> IO Color) -> IO Color)
-> (Ptr Color -> IO Color) -> IO Color
forall a b. (a -> b) -> a -> b
$ \ Ptr Color
exact_def_return -> do
        String -> IO CInt -> IO ()
throwIfZero String
"parseColor" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
                Display -> Pixel -> CString -> Ptr Color -> IO CInt
xParseColor Display
display Pixel
colormap CString
spec Ptr Color
exact_def_return
        Ptr Color -> IO Color
forall a. Storable a => Ptr a -> IO a
peek Ptr Color
exact_def_return

foreign import ccall unsafe "HsXlib.h XParseColor"
        xParseColor :: Display -> Colormap -> CString -> Ptr Color -> IO Status

-- ToDo: Can't express relationship between arg4 and res1 properly (or arg5, res2)
-- %errfun Zero XAllocColorCells :: Display -> Colormap -> Bool -> Int -> Int -> IO (ListPixel, ListPixel) using err = XAllocColorCells(arg1,arg2,arg3,arg4_size,res1,arg5_size,res2)

-- ToDo: Can't express relationship between arg4 and res1 properly
-- %errfun Zero XAllocColorPlanes :: Display -> Colormap -> Bool -> Int -> Int -> Int -> Int IO (ListPixel, Pixel, Pixel, Pixel) using err = XAllocColorPlanes(...)

-- | interface to the X11 library function @XFreeColors()@.
freeColors :: Display -> Colormap -> [Pixel] -> Pixel -> IO ()
freeColors :: Display -> Pixel -> [Pixel] -> Pixel -> IO ()
freeColors Display
display Pixel
colormap [Pixel]
pixels Pixel
planes =
        [Pixel] -> (Ptr Pixel -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Pixel]
pixels ((Ptr Pixel -> IO ()) -> IO ()) -> (Ptr Pixel -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Pixel
pixel_array ->
        Display -> Pixel -> Ptr Pixel -> CInt -> Pixel -> IO ()
xFreeColors Display
display Pixel
colormap Ptr Pixel
pixel_array (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Pixel] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pixel]
pixels)) Pixel
planes

foreign import ccall unsafe "HsXlib.h XFreeColors"
        xFreeColors :: Display -> Colormap -> Ptr Pixel -> CInt -> Pixel -> IO ()

-- | interface to the X11 library function @XStoreColor()@.
storeColor :: Display -> Colormap -> Color -> IO ()
storeColor :: Display -> Pixel -> Color -> IO ()
storeColor Display
display Pixel
colormap Color
color =
        Color -> (Ptr Color -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color ((Ptr Color -> IO ()) -> IO ()) -> (Ptr Color -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Color
color_ptr ->
        Display -> Pixel -> Ptr Color -> IO ()
xStoreColor Display
display Pixel
colormap Ptr Color
color_ptr

foreign import ccall unsafe "HsXlib.h XStoreColor"
        xStoreColor  :: Display -> Colormap -> Ptr Color -> IO ()

-- %fun XStoreColors :: Display -> Colormap -> ListColor -> IO ()
-- %code XStoreColors(arg1,arg2,arg3,arg3_size)
-- %fun XStoreNamedColor :: Display -> Colormap -> String -> Pixel -> PrimaryMask -> IO ()

-- | interface to the X11 library function @XQueryColor()@.
queryColor :: Display -> Colormap -> Color -> IO Color
queryColor :: Display -> Pixel -> Color -> IO Color
queryColor Display
display Pixel
colormap Color
color =
        Color -> (Ptr Color -> IO Color) -> IO Color
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color ((Ptr Color -> IO Color) -> IO Color)
-> (Ptr Color -> IO Color) -> IO Color
forall a b. (a -> b) -> a -> b
$ \ Ptr Color
color_ptr -> do
        Display -> Pixel -> Ptr Color -> IO ()
xQueryColor Display
display Pixel
colormap Ptr Color
color_ptr
        Ptr Color -> IO Color
forall a. Storable a => Ptr a -> IO a
peek Ptr Color
color_ptr

foreign import ccall unsafe "HsXlib.h XQueryColor"
        xQueryColor  :: Display -> Colormap -> Ptr Color -> IO ()

-- | interface to the X11 library function @XQueryColors()@.
queryColors :: Display -> Colormap -> [Color] -> IO [Color]
queryColors :: Display -> Pixel -> [Color] -> IO [Color]
queryColors Display
display Pixel
colormap [Color]
colors =
        [Color] -> (Int -> Ptr Color -> IO [Color]) -> IO [Color]
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Color]
colors ((Int -> Ptr Color -> IO [Color]) -> IO [Color])
-> (Int -> Ptr Color -> IO [Color]) -> IO [Color]
forall a b. (a -> b) -> a -> b
$ \ Int
ncolors Ptr Color
color_array -> do
        Display -> Pixel -> Ptr Color -> CInt -> IO ()
xQueryColors Display
display Pixel
colormap Ptr Color
color_array (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ncolors)
        Int -> Ptr Color -> IO [Color]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
ncolors Ptr Color
color_array

foreign import ccall unsafe "HsXlib.h XQueryColors"
        xQueryColors :: Display -> Colormap -> Ptr Color -> CInt -> IO ()

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

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

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

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

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

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