summaryrefslogtreecommitdiffhomepage
path: root/XUtil.hsc
diff options
context:
space:
mode:
Diffstat (limited to 'XUtil.hsc')
-rw-r--r--XUtil.hsc16
1 files changed, 10 insertions, 6 deletions
diff --git a/XUtil.hsc b/XUtil.hsc
index 0ea39a8..3250b26 100644
--- a/XUtil.hsc
+++ b/XUtil.hsc
@@ -177,23 +177,27 @@ printString dpy drw fs@(Xft font) gc fc bc x y s = do
\color -> xftDrawString draw color font x y s
#endif
+data DynPixel = DynPixel { allocated :: Bool
+ , pixel :: Pixel
+ }
+
-- | Get the Pixel value for a named color: if an invalid name is
-- given the black pixel will be returned.
-initColor :: Display -> String -> IO (Bool, Pixel)
+initColor :: Display -> String -> IO DynPixel
initColor dpy c = (initColor' dpy c) `catch`
- (const $ return (False, blackPixel dpy $ defaultScreen dpy))
+ (const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy))
-initColor' :: Display -> String -> IO (Bool, Pixel)
+initColor' :: Display -> String -> IO DynPixel
initColor' dpy c = do
(c', _) <- allocNamedColor dpy colormap c
- return (True, color_pixel c')
+ return $ DynPixel True (color_pixel c')
where colormap = defaultColormap dpy (defaultScreen dpy)
withColors :: MonadIO m => Display -> [String] -> ([Pixel] -> m a) -> m a
withColors d cs f = do
ps <- mapM (io . initColor d) cs
- r <- f $ map snd ps
- io $ freeColors d cmap (map snd $ filter fst ps) 0
+ r <- f $ map pixel ps
+ io $ freeColors d cmap (map pixel $ filter allocated ps) 0
return r
where
cmap = defaultColormap d (defaultScreen d)