1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
-----------------------------------------------------------------------------
-- |
-- 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 colormap color_name =
withCString color_name $ \c_color_name ->
alloca $ \ exact_def_return ->
alloca $ \ screen_def_return -> do
throwIfZero "lookupColor" $
xLookupColor display colormap c_color_name
exact_def_return screen_def_return
exact_def <- peek exact_def_return
screen_def <- peek screen_def_return
return (exact_def, 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 colormap color_name =
withCString color_name $ \c_color_name ->
alloca $ \ exact_def_return ->
alloca $ \ screen_def_return -> do
throwIfZero "allocNamedColor" $
xAllocNamedColor display colormap c_color_name
exact_def_return screen_def_return
exact_def <- peek exact_def_return
screen_def <- peek screen_def_return
return (exact_def, 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 colormap color =
with color $ \ color_ptr -> do
throwIfZero "allocColor" $
xAllocColor display colormap color_ptr
peek 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 colormap color_spec =
withCString color_spec $ \ spec ->
alloca $ \ exact_def_return -> do
throwIfZero "parseColor" $
xParseColor display colormap spec exact_def_return
peek 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 colormap pixels planes =
withArray pixels $ \ pixel_array ->
xFreeColors display colormap pixel_array (fromIntegral (length pixels)) 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 colormap color =
with color $ \ color_ptr ->
xStoreColor display colormap 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 colormap color =
with color $ \ color_ptr -> do
xQueryColor display colormap color_ptr
peek 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 colormap colors =
withArrayLen colors $ \ ncolors color_array -> do
xQueryColors display colormap color_array (fromIntegral ncolors)
peekArray ncolors 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
----------------------------------------------------------------
|
