aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Util
diff options
context:
space:
mode:
Diffstat (limited to 'XMonad/Util')
-rw-r--r--XMonad/Util/Font.cpphs36
-rw-r--r--XMonad/Util/XUtils.hs4
2 files changed, 19 insertions, 21 deletions
diff --git a/XMonad/Util/Font.cpphs b/XMonad/Util/Font.cpphs
index 56fe43e..496691b 100644
--- a/XMonad/Util/Font.cpphs
+++ b/XMonad/Util/Font.cpphs
@@ -52,12 +52,10 @@ data XMonadFont = Core FontStruct
-- | Get the Pixel value for a named color: if an invalid name is
-- given the black pixel will be returned.
-stringToPixel :: String -> X Pixel
-stringToPixel s = do
- d <- asks display
- io $ catch (getIt d) (fallBack d)
- where getIt d = initColor d s
- fallBack d = const $ return $ blackPixel d (defaultScreen d)
+stringToPixel :: MonadIO m => Display -> String -> m Pixel
+stringToPixel d s = liftIO $ catch getIt fallBack
+ where getIt = initColor d s
+ fallBack = const $ return $ blackPixel d (defaultScreen d)
-- | Given a fontname returns the font structure. If the font name is
@@ -99,18 +97,18 @@ releaseXMF (Xft xftfont) = do
io $ xftFontClose dpy xftfont
#endif
-textWidthXMF :: Display -> XMonadFont -> String -> IO Int
+textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int
textWidthXMF _ (Core fs) s = return $ fi $ textWidth fs s
#ifdef XFT
-textWidthXMF dpy (Xft xftdraw) s = do
+textWidthXMF dpy (Xft xftdraw) s = liftIO $ do
gi <- xftTextExtents dpy xftdraw s
return $ xglyphinfo_width gi
#endif
-textExtentsXMF :: Display -> XMonadFont -> String -> IO (FontDirection,Int32,Int32,CharStruct)
+textExtentsXMF :: MonadIO m => Display -> XMonadFont -> String -> m (FontDirection,Int32,Int32,CharStruct)
textExtentsXMF _ (Core fs) s = return $ textExtents fs s
#ifdef XFT
-textExtentsXMF _ (Xft xftfont) _ = do
+textExtentsXMF _ (Xft xftfont) _ = liftIO $ do
ascent <- xftfont_ascent xftfont
descent <- xftfont_descent xftfont
return (error "Font direction touched", fi ascent, fi descent, error "Font overall size touched")
@@ -134,21 +132,21 @@ stringPosition fs (Rectangle _ _ w h) al s = do
return (x,y)
-printStringXMF :: Display -> Drawable -> XMonadFont -> GC -> String -> String
- -> Position -> Position -> String -> X ()
-printStringXMF d p (Core fs) gc fc bc x y s = do
- io $ setFont d gc $ fontFromFontStruct fs
- [fc',bc'] <- mapM stringToPixel [fc,bc]
- io $ setForeground d gc fc'
- io $ setBackground d gc bc'
- io $ drawImageString d p gc x y s
+printStringXMF :: MonadIO m => Display -> Drawable -> XMonadFont -> GC -> String -> String
+ -> Position -> Position -> String -> m ()
+printStringXMF d p (Core fs) gc fc bc x y s = liftIO $ do
+ setFont d gc $ fontFromFontStruct fs
+ [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
+ setForeground d gc fc'
+ setBackground d gc bc'
+ drawImageString d p gc x y s
#ifdef XFT
printStringXMF dpy drw (Xft font) _ fc _ x y s = do
let screen = defaultScreenOfDisplay dpy;
colormap = defaultColormapOfScreen screen;
visual = defaultVisualOfScreen screen;
- io $ withXftDraw dpy drw visual colormap $
+ liftIO $ withXftDraw dpy drw visual colormap $
\draw -> withXftColorName dpy visual colormap fc $
\color -> xftDrawString draw color font x y s
#endif
diff --git a/XMonad/Util/XUtils.hs b/XMonad/Util/XUtils.hs
index 9f4bc69..e53d371 100644
--- a/XMonad/Util/XUtils.hs
+++ b/XMonad/Util/XUtils.hs
@@ -53,7 +53,7 @@ createNewWindow :: Rectangle -> Maybe EventMask -> String -> X Window
createNewWindow (Rectangle x y w h) m col = do
d <- asks display
rw <- asks theRoot
- c <- stringToPixel col
+ c <- stringToPixel d col
win <- io $ createSimpleWindow d rw x y w h 0 c c
case m of
Just em -> io $ selectInput d win em
@@ -116,7 +116,7 @@ paintWindow' win (Rectangle x y wh ht) bw color b_color str = do
gc <- io $ createGC d p
-- draw
io $ setGraphicsExposures d gc False
- [color',b_color'] <- mapM stringToPixel [color,b_color]
+ [color',b_color'] <- mapM (stringToPixel d) [color,b_color]
-- we start with the border
io $ setForeground d gc b_color'
io $ fillRectangle d p gc 0 0 wh ht