aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Util/Font.hs
diff options
context:
space:
mode:
authorSpencer Janssen <sjanssen@cse.unl.edu>2007-11-16 22:57:20 +0100
committerSpencer Janssen <sjanssen@cse.unl.edu>2007-11-16 22:57:20 +0100
commit7cd1a62cf81826a72dc9a4ae6adc3b40dbd646da (patch)
treee00a604cba5c0f13fbd359aef7fb80db0d080e7a /XMonad/Util/Font.hs
parenta4813570daddeb156e06110c3200a2b96dc808b7 (diff)
downloadXMonadContrib-7cd1a62cf81826a72dc9a4ae6adc3b40dbd646da.tar.gz
XMonadContrib-7cd1a62cf81826a72dc9a4ae6adc3b40dbd646da.tar.xz
XMonadContrib-7cd1a62cf81826a72dc9a4ae6adc3b40dbd646da.zip
Move XMonad.Util.Font to fix haddock generation
darcs-hash:20071116215720-a5988-b4f40df339aeed5736edcb35b1a85424403d947d.gz
Diffstat (limited to 'XMonad/Util/Font.hs')
-rw-r--r--XMonad/Util/Font.hs161
1 files changed, 0 insertions, 161 deletions
diff --git a/XMonad/Util/Font.hs b/XMonad/Util/Font.hs
deleted file mode 100644
index b244fb5..0000000
--- a/XMonad/Util/Font.hs
+++ /dev/null
@@ -1,161 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-----------------------------------------------------------------------------
--- |
--- Module : XMonad.Util.Font
--- Copyright : (c) 2007 Andrea Rossato
--- 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 Graphics.X11.Xlib
-import Control.Monad.Reader
-import XMonad
-import Foreign
-import XMonad.Operations
-
-#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 Tabbed or 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 :: String -> X Pixel
-stringToPixel s = do
- d <- asks display
- io $ catch (getIt d) (fallBack d)
- where getIt d = initColor d s
- fallBack d = const $ return $ 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 :: Display -> XMonadFont -> String -> IO Int
-textWidthXMF _ (Core fs) s = return $ fi $ textWidth fs s
-#ifdef XFT
-textWidthXMF dpy (Xft xftdraw) s = do
- gi <- xftTextExtents dpy xftdraw s
- return $ xglyphinfo_width gi
-#endif
-
-textExtentsXMF :: Display -> XMonadFont -> String -> IO (FontDirection,Int32,Int32,CharStruct)
-textExtentsXMF _ (Core fs) s = return $ textExtents fs s
-#ifdef XFT
-textExtentsXMF _ (Xft xftfont) _ = 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 dpy 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 :: Display -> Drawable -> XMonadFont -> GC -> String -> String
- -> Position -> Position -> String -> X ()
-printStringXMF d p (Core fs) gc fc bc x y s = do
- io $ setFont d gc $ fontFromFontStruct fs
- [fc',bc'] <- mapM stringToPixel [fc,bc]
- io $ setForeground d gc fc'
- io $ setBackground d gc bc'
- io $ 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;
- io $ 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