diff options
author | Andrea Rossato <andrea.rossato@unibz.it> | 2008-03-02 10:57:12 +0100 |
---|---|---|
committer | Andrea Rossato <andrea.rossato@unibz.it> | 2008-03-02 10:57:12 +0100 |
commit | 1085043f0ceb4a3f76e7fed3f9ddd0f2b59cb6c5 (patch) | |
tree | ac0600f88d017b024c50f43251ebdfff7363e496 /XMonad/Util/Font.cpphs | |
parent | e832f8bfa00a9e1c094604ccaea9aa38ceed2bc9 (diff) | |
download | XMonadContrib-1085043f0ceb4a3f76e7fed3f9ddd0f2b59cb6c5.tar.gz XMonadContrib-1085043f0ceb4a3f76e7fed3f9ddd0f2b59cb6c5.tar.xz XMonadContrib-1085043f0ceb4a3f76e7fed3f9ddd0f2b59cb6c5.zip |
Font and XUtils: add UTF-8 support and various fixes related to XFT
- printStringXMF: use the background color for XFT fonts too
- textWidthXMF now returns the text width even with xft fonts
- textExtentsXMF will now return only the ascend and the descent of a
string.
- stringPosition now takes the display too
- add support for UTF-8 locales: if the contrib library is compiled
with the 'with_xft' or the 'with_utf8' option the prompt and the
decoration system will support UTF-8 locales - this requires
utf8-strings.
darcs-hash:20080302095712-32816-f3d6d06ff9d921288b1625e4bfd643013d2075ec.gz
Diffstat (limited to 'XMonad/Util/Font.cpphs')
-rw-r--r-- | XMonad/Util/Font.cpphs | 156 |
1 files changed, 0 insertions, 156 deletions
diff --git a/XMonad/Util/Font.cpphs b/XMonad/Util/Font.cpphs deleted file mode 100644 index b6cf2ad..0000000 --- a/XMonad/Util/Font.cpphs +++ /dev/null @@ -1,156 +0,0 @@ ----------------------------------------------------------------------------- --- | --- Module : XMonad.Util.Font --- Copyright : (c) 2007 Andrea Rossato and Spencer Janssen --- License : BSD-style (see xmonad/LICENSE) --- --- Maintainer : andrea.rossato@unibz.it --- Stability : unstable --- Portability : unportable --- --- A module for abstracting a font facility over Core fonts and Xft --- ------------------------------------------------------------------------------ - -module XMonad.Util.Font ( - -- * Usage: - -- $usage - XMonadFont(..) - , initXMF - , releaseXMF - , initCoreFont - , releaseCoreFont - , Align (..) - , stringPosition - , textWidthXMF - , textExtentsXMF - , printStringXMF - , stringToPixel - ) where - - -import XMonad -import Foreign -import Control.Applicative -import Data.Maybe - -#ifdef XFT -import Data.List -import Graphics.X11.Xft -import Graphics.X11.Xrender -#endif - --- Hide the Core Font/Xft switching here -data XMonadFont = Core FontStruct -#ifdef XFT - | Xft XftFont -#endif - --- $usage --- See "Xmonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples - --- | Get the Pixel value for a named color: if an invalid name is --- given the black pixel will be returned. -stringToPixel :: (Functor m, MonadIO m) => Display -> String -> m Pixel -stringToPixel d s = fromMaybe fallBack <$> liftIO getIt - where getIt = initColor d s - fallBack = blackPixel d (defaultScreen d) - - --- | Given a fontname returns the font structure. If the font name is --- not valid the default font will be loaded and returned. -initCoreFont :: String -> X FontStruct -initCoreFont s = do - d <- asks display - io $ catch (getIt d) (fallBack d) - where getIt d = loadQueryFont d s - fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - -releaseCoreFont :: FontStruct -> X () -releaseCoreFont fs = do - d <- asks display - io $ freeFont d fs - --- | When initXMF gets a font name that starts with 'xft:' it switchs to the Xft backend --- Example: 'xft: Sans-10' -initXMF :: String -> X XMonadFont -initXMF s = -#ifdef XFT - if xftPrefix `isPrefixOf` s then - do - dpy <- asks display - xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s) - return (Xft xftdraw) - else -#endif - (initCoreFont s >>= (return . Core)) -#ifdef XFT - where xftPrefix = "xft:" -#endif - -releaseXMF :: XMonadFont -> X () -releaseXMF (Core fs) = releaseCoreFont fs -#ifdef XFT -releaseXMF (Xft xftfont) = do - dpy <- asks display - io $ xftFontClose dpy xftfont -#endif - -textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int -textWidthXMF _ (Core fs) s = return $ fi $ textWidth fs s -#ifdef XFT -textWidthXMF dpy (Xft xftdraw) s = liftIO $ do - gi <- xftTextExtents dpy xftdraw s - return $ xglyphinfo_width gi -#endif - -textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (FontDirection,Int32,Int32,CharStruct) -textExtentsXMF (Core fs) s = return $ textExtents fs s -#ifdef XFT -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") -#endif - --- | String position -data Align = AlignCenter | AlignRight | AlignLeft - --- | Return the string x and y 'Position' in a 'Rectangle', given a --- 'FontStruct' and the 'Align'ment -stringPosition :: XMonadFont -> Rectangle -> Align -> String -> X (Position,Position) -stringPosition fs (Rectangle _ _ w h) al s = do - dpy <- asks display - width <- io $ textWidthXMF dpy fs s - (_,a,d,_) <- io $ textExtentsXMF fs s - let y = fi $ ((h - fi (a + d)) `div` 2) + fi a; - x = case al of - AlignCenter -> fi (w `div` 2) - fi (width `div` 2) - AlignLeft -> 1 - AlignRight -> fi (w - (fi width + 1)); - return (x,y) - - -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; - liftIO $ withXftDraw dpy drw visual colormap $ - \draw -> withXftColorName dpy visual colormap fc $ - \color -> xftDrawString draw color font x y s -#endif - - --- | Short-hand for 'fromIntegral' -fi :: (Integral a, Num b) => a -> b -fi = fromIntegral |