stockholm/tv/5pkgs/xmonad-tv/Util/Font.hs

124 lines
4.5 KiB
Haskell

{-# LANGUAGE CPP #-}
module Util.Font
( printStringCentered
, printStringXMF'
) where
import XMonad
import XMonad.Util.Font
printStringCentered :: (Functor m, MonadIO m)
=> Display -> Drawable -> XMonadFont
-> GC -> Rectangle -> String
-> m ()
printStringCentered d p xmf gc r s = do
let x = rect_x r
y = rect_y r
w = rect_width r
h = rect_height r
text_w <- textWidthXMF d xmf s
(text_ascent, _) <- textExtentsXMF xmf s
let text_x = x + round ((fi w - fi text_w) / 2)
text_y = y + round ((fi h + fi text_h) / 2)
text_h = text_ascent
printStringXMF' d p xmf gc "" "" text_x text_y s
-- from xmonad-contrib's XMonad.Util.Font, (c) 2007 Andrea Rossato and Spencer Janssen
printStringXMF' :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String
-> Position -> Position -> String -> m ()
printStringXMF' d p (Core fs) gc fc bc x y s = io $ do
setFont d gc $ fontFromFontStruct fs
--tv [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
--tv setForeground d gc fc'
--tv setBackground d gc bc'
drawImageString d p gc x y s
printStringXMF' d p (Utf8 fs) gc fc bc x y s = io $ do
--tv [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
--tv setForeground d gc fc'
--tv setBackground d gc bc'
io $ wcDrawImageString d p fs gc x y s
#ifdef XFT
printStringXMF' dpy drw fs@(Xft font) gc fc bc x y s = do
let screen = defaultScreenOfDisplay dpy
colormap = defaultColormapOfScreen screen
visual = defaultVisualOfScreen screen
--tv bcolor <- stringToPixel dpy bc
(a,d) <- textExtentsXMF fs s
gi <- io $ xftTextExtents dpy font s
--tv io $ setForeground dpy gc bcolor
io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi))
(y - fi a)
(fi $ xglyphinfo_xOff gi)
(fi $ a + d)
io $ withXftDraw dpy drw visual colormap $
\draw -> withXftColorName dpy visual colormap fc $
\color -> xftDrawString draw color font x y s
#endif
-- --my_printStringXMF :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String
-- -- -> Position -> Position -> String -> m ()
-- my_printStringXMF (Core fs) d p gc x y s = 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
-- my_printStringXMF (Utf8 fs) d p gc x y s = do
-- -- [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
-- -- setForeground d gc fc'
-- -- setBackground d gc bc'
-- wcDrawImageString d p fs gc x y s
-- #ifdef XFT
-- my_printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do
-- let screen = defaultScreenOfDisplay dpy
-- colormap = defaultColormapOfScreen screen
-- visual = defaultVisualOfScreen screen
-- bcolor <- stringToPixel dpy bc
-- (a,d) <- textExtentsXMF fs s
-- gi <- io $ xftTextExtents dpy font s
-- io $ setForeground dpy gc bcolor
-- io $ fillRectangle dpy drw gc (x - fromIntegral (xglyphinfo_x gi))
-- (y - fromIntegral a)
-- (fromIntegral $ xglyphinfo_xOff gi)
-- (fromIntegral $ a + d)
-- io $ withXftDraw dpy drw visual colormap $
-- \draw -> withXftColorName dpy visual colormap fc $
-- \color -> xftDrawString draw color font x y s
-- #endif
-- --textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int
-- my_textWidthXMF _ (Utf8 fs) s = return $ fromIntegral $ wcTextEscapement fs s
-- my_textWidthXMF _ (Core fs) s = return $ fromIntegral $ textWidth fs s
-- #ifdef XFT
-- my_TextWidthXMF dpy (Xft xftdraw) s = liftIO $ do
-- gi <- xftTextExtents dpy xftdraw s
-- return $ xglyphinfo_xOff gi
-- #endif
--
-- my_textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32)
-- my_textExtentsXMF (Utf8 fs) s = do
-- let (_,rl) = wcTextExtents fs s
-- ascent = fromIntegral $ - (rect_y rl)
-- descent = fromIntegral $ rect_height rl + (fromIntegral $ rect_y rl)
-- return (ascent, descent)
-- my_textExtentsXMF (Core fs) s = do
-- let (_,a,d,_) = textExtents fs s
-- return (a,d)
-- #ifdef XFT
-- my_textExtentsXMF (Xft xftfont) _ = io $ do
-- ascent <- fromIntegral `fmap` xftfont_ascent xftfont
-- descent <- fromIntegral `fmap` xftfont_descent xftfont
-- return (ascent, descent)
-- #endif