diff options
Diffstat (limited to 'XMonad/Util')
| -rw-r--r-- | XMonad/Util/Font.cpphs | 36 | ||||
| -rw-r--r-- | XMonad/Util/XUtils.hs | 4 |
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 |