diff options
Diffstat (limited to 'src/Xmobar/X11/ColorCache.hs')
-rw-r--r-- | src/Xmobar/X11/ColorCache.hs | 48 |
1 files changed, 25 insertions, 23 deletions
diff --git a/src/Xmobar/X11/ColorCache.hs b/src/Xmobar/X11/ColorCache.hs index b981775..a8a07cd 100644 --- a/src/Xmobar/X11/ColorCache.hs +++ b/src/Xmobar/X11/ColorCache.hs @@ -17,43 +17,45 @@ module Xmobar.X11.ColorCache(withColors) where -import Data.IORef -import System.IO.Unsafe (unsafePerformIO) -import Control.Monad.Trans (MonadIO, liftIO) -import Control.Exception (SomeException, handle) -import Graphics.X11.Xlib +import qualified Data.IORef as IO +import qualified System.IO.Unsafe as U -data DynPixel = DynPixel Bool Pixel +import qualified Control.Exception as E +import qualified Control.Monad.Trans as Tr -initColor :: Display -> String -> IO DynPixel -initColor dpy c = handle black $ initColor' dpy c +import qualified Graphics.X11.Xlib as X + +data DynPixel = DynPixel Bool X.Pixel + +initColor :: X.Display -> String -> IO DynPixel +initColor dpy c = E.handle black $ initColor' dpy c where - black :: SomeException -> IO DynPixel - black = const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy) + black :: E.SomeException -> IO DynPixel + black = const . return $ DynPixel False (X.blackPixel dpy $ X.defaultScreen dpy) -type ColorCache = [(String, Color)] +type ColorCache = [(String, X.Color)] {-# NOINLINE colorCache #-} -colorCache :: IORef ColorCache -colorCache = unsafePerformIO $ newIORef [] +colorCache :: IO.IORef ColorCache +colorCache = U.unsafePerformIO $ IO.newIORef [] -getCachedColor :: String -> IO (Maybe Color) -getCachedColor color_name = lookup color_name `fmap` readIORef colorCache +getCachedColor :: String -> IO (Maybe X.Color) +getCachedColor color_name = lookup color_name `fmap` IO.readIORef colorCache -putCachedColor :: String -> Color -> IO () -putCachedColor name c_id = modifyIORef colorCache $ \c -> (name, c_id) : c +putCachedColor :: String -> X.Color -> IO () +putCachedColor name c_id = IO.modifyIORef colorCache $ \c -> (name, c_id) : c -initColor' :: Display -> String -> IO DynPixel +initColor' :: X.Display -> String -> IO DynPixel initColor' dpy c = do - let colormap = defaultColormap dpy (defaultScreen dpy) + let colormap = X.defaultColormap dpy (X.defaultScreen dpy) cached_color <- getCachedColor c c' <- case cached_color of Just col -> return col - _ -> do (c'', _) <- allocNamedColor dpy colormap c + _ -> do (c'', _) <- X.allocNamedColor dpy colormap c putCachedColor c c'' return c'' - return $ DynPixel True (color_pixel c') + return $ DynPixel True (X.color_pixel c') -withColors :: MonadIO m => Display -> [String] -> ([Pixel] -> m a) -> m a +withColors :: Tr.MonadIO m => X.Display -> [String] -> ([X.Pixel] -> m a) -> m a withColors d cs f = do - ps <- mapM (liftIO . initColor d) cs + ps <- mapM (Tr.liftIO . initColor d) cs f $ map (\(DynPixel _ pixel) -> pixel) ps |