# 1 "XMonad/Util/Font.cpphs"
# 1 "<built-in>"
# 1 "<command-line>"
# 1 "XMonad/Util/Font.cpphs"
module XMonad.Util.Font (
XMonadFont(..)
, initXMF
, releaseXMF
, initCoreFont
, releaseCoreFont
, Align (..)
, stringPosition
, textWidthXMF
, textExtentsXMF
, printStringXMF
, stringToPixel
) where
import XMonad
import Foreign
data XMonadFont = Core FontStruct
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)
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
initXMF :: String -> X XMonadFont
initXMF s =
# 84 "XMonad/Util/Font.cpphs"
(initCoreFont s >>= (return . Core))
releaseXMF :: XMonadFont -> X ()
releaseXMF (Core fs) = releaseCoreFont fs
textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int
textWidthXMF _ (Core fs) s = return $ fi $ textWidth fs s
textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (FontDirection,Int32,Int32,CharStruct)
textExtentsXMF (Core fs) s = return $ textExtents fs s
data Align = AlignCenter | AlignRight | AlignLeft
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
# 150 "XMonad/Util/Font.cpphs"
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral