Wrapped pixel allocation in DynPixel type

The (Bool, Pixel) pair for controlling the allocation and deallocation of
pixels seemed hackish.  This version is a compromise between not having to
add too much boilerplate and being more expressive.

darcs-hash:20090409124658-c6b6b-5758e748a7e1591f22abb83160594323b472da3a.gz

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)