diff options
Diffstat (limited to 'src/XUtil.hsc')
| -rw-r--r-- | src/XUtil.hsc | 42 |
1 files changed, 26 insertions, 16 deletions
diff --git a/src/XUtil.hsc b/src/XUtil.hsc index c3bca7c..e333a22 100644 --- a/src/XUtil.hsc +++ b/src/XUtil.hsc @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : XUtil --- Copyright : (C) 2011, 2012, 2013 Jose Antonio Ortega Ruiz +-- Copyright : (C) 2011, 2012, 2013, 2014 Jose Antonio Ortega Ruiz -- (C) 2007 Andrea Rossato -- License : BSD3 -- @@ -102,7 +102,7 @@ hGetLineSafe = hGetLine data XFont = Core FontStruct | Utf8 FontSet #ifdef XFT - | Xft AXftFont + | Xft [AXftFont] #endif -- | When initFont gets a font name that starts with 'xft:' it switchs @@ -122,7 +122,7 @@ initFont d s = #endif miscFixedFont :: String -miscFixedFont = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" +miscFixedFont = "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*" -- | Given a fontname returns the font structure. If the font name is -- not valid the default font will be loaded and returned. @@ -148,12 +148,22 @@ initUtf8Font d s = do fallBack = const $ createFontSet d miscFixedFont #ifdef XFT -initXftFont :: Display -> String -> IO AXftFont +initXftFont :: Display -> String -> IO [AXftFont] initXftFont d s = do setupLocale - f <- openAXftFont d (defaultScreenOfDisplay d) (drop 4 s) - addFinalizer f (closeAXftFont d f) - return f + let fontNames = wordsBy (== ',') (drop 4 s) + fonts <- mapM openFont fontNames + return fonts + where + openFont fontName = do + f <- openAXftFont d (defaultScreenOfDisplay d) fontName + addFinalizer f (closeAXftFont d f) + return f + wordsBy p str = case dropWhile p str of + "" -> [] + str' -> w : wordsBy p str'' + where + (w, str'') = break p str' #endif textWidth :: Display -> XFont -> String -> IO Int @@ -161,7 +171,7 @@ textWidth _ (Utf8 fs) s = return $ fi $ wcTextEscapement fs s textWidth _ (Core fs) s = return $ fi $ Xlib.textWidth fs s #ifdef XFT textWidth dpy (Xft xftdraw) s = do - gi <- xftTxtExtents dpy xftdraw s + gi <- xftTxtExtents' dpy xftdraw s return $ xglyphinfo_xOff gi #endif @@ -175,9 +185,9 @@ textExtents (Utf8 fs) s = do descent = fi $ rect_height rl + (fi $ rect_y rl) return (ascent, descent) #ifdef XFT -textExtents (Xft xftfont) _ = do - ascent <- fi `fmap` xft_ascent xftfont - descent <- fi `fmap` xft_descent xftfont +textExtents (Xft xftfonts) _ = do + ascent <- fi `fmap` xft_ascent' xftfonts + descent <- fi `fmap` xft_descent' xftfonts return (ascent, descent) #endif @@ -185,21 +195,21 @@ printString :: Display -> Drawable -> XFont -> GC -> String -> String -> Position -> Position -> String -> IO () printString d p (Core fs) gc fc bc x y s = do setFont d gc $ fontFromFontStruct fs - withColors d [fc, bc] $ \[fc', bc'] -> do + withColors d [fc, bc] $ \[fc', _] -> do setForeground d gc fc' drawImageString d p gc x y s printString d p (Utf8 fs) gc fc bc x y s = - withColors d [fc, bc] $ \[fc', bc'] -> do + withColors d [fc, bc] $ \[fc', _] -> do setForeground d gc fc' io $ wcDrawImageString d p fs gc x y s #ifdef XFT -printString dpy drw fs@(Xft font) _ fc bc x y s = do +printString dpy drw fs@(Xft fonts) _ fc bc x y s = do (a,d) <- textExtents fs s - gi <- xftTxtExtents dpy font s + gi <- xftTxtExtents' dpy fonts s withDrawingColors dpy drw fc bc $ \draw -> \fc' -> \bc' -> - (drawXftString draw fc' font x (y - 2) s) + (drawXftString' draw fc' fonts (toInteger x) (toInteger (y - 2)) s) #endif |