summaryrefslogtreecommitdiffstats
path: root/tv/5pkgs/xmonad-tv/Util/Font.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tv/5pkgs/xmonad-tv/Util/Font.hs')
-rw-r--r--tv/5pkgs/xmonad-tv/Util/Font.hs123
1 files changed, 123 insertions, 0 deletions
diff --git a/tv/5pkgs/xmonad-tv/Util/Font.hs b/tv/5pkgs/xmonad-tv/Util/Font.hs
new file mode 100644
index 000000000..5352cf5ad
--- /dev/null
+++ b/tv/5pkgs/xmonad-tv/Util/Font.hs
@@ -0,0 +1,123 @@
+{-# 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