diff options
author | nzeh <nzeh@cs.dal.ca> | 2009-04-09 14:46:58 +0200 |
---|---|---|
committer | nzeh <nzeh@cs.dal.ca> | 2009-04-09 14:46:58 +0200 |
commit | 89af7bf2fe33dce5dea70bc7564dbdca69117e37 (patch) | |
tree | 9731ae03a8a10701837dbb8a85c666c7caf68449 /XUtil.hsc | |
parent | 83243937b55862136a0d41303d318d07e51db982 (diff) | |
download | xmobar-89af7bf2fe33dce5dea70bc7564dbdca69117e37.tar.gz xmobar-89af7bf2fe33dce5dea70bc7564dbdca69117e37.tar.bz2 |
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
Diffstat (limited to 'XUtil.hsc')
-rw-r--r-- | XUtil.hsc | 16 |
1 files changed, 10 insertions, 6 deletions
@@ -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) |