{-# LANGUAGE CPP #-}
module Xmobar.X11.Text
( XFont
, initFont
, textExtents
, textWidth
) where
import qualified Control.Exception as E
import qualified Foreign as F
import qualified System.Mem.Weak as W
import qualified Graphics.X11.Xlib as X
import qualified Graphics.X11.Xlib.Extras as Xx
type XFont = Xx.FontSet
initFont :: X.Display -> String -> IO XFont
initFont :: Display -> String -> IO XFont
initFont = Display -> String -> IO XFont
initUtf8Font
miscFixedFont :: String
miscFixedFont :: String
miscFixedFont = String
"-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*"
initUtf8Font :: X.Display -> String -> IO Xx.FontSet
initUtf8Font :: Display -> String -> IO XFont
initUtf8Font Display
d String
s = do
([String]
_,String
_,XFont
f) <- forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle SomeException -> IO ([String], String, XFont)
fallBack IO ([String], String, XFont)
getIt
forall key. key -> IO () -> IO ()
W.addFinalizer XFont
f (Display -> XFont -> IO ()
Xx.freeFontSet Display
d XFont
f)
forall (m :: * -> *) a. Monad m => a -> m a
return XFont
f
where getIt :: IO ([String], String, XFont)
getIt = Display -> String -> IO ([String], String, XFont)
Xx.createFontSet Display
d String
s
fallBack :: E.SomeException -> IO ([String], String, Xx.FontSet)
fallBack :: SomeException -> IO ([String], String, XFont)
fallBack = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Display -> String -> IO ([String], String, XFont)
Xx.createFontSet Display
d String
miscFixedFont
textWidth :: X.Display -> XFont -> String -> IO Int
textWidth :: Display -> XFont -> String -> IO Int
textWidth Display
_ XFont
fs String
s = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ XFont -> String -> Int32
Xx.wcTextEscapement XFont
fs String
s
textExtents :: XFont -> String -> IO (F.Int32, F.Int32)
textExtents :: XFont -> String -> IO (Int32, Int32)
textExtents XFont
fs String
s = do
let (Rectangle
_,Rectangle
rl) = XFont -> String -> (Rectangle, Rectangle)
Xx.wcTextExtents XFont
fs String
s
ascent :: Int32
ascent = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate (Rectangle -> Int32
X.rect_y Rectangle
rl)
descent :: Int32
descent = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
X.rect_height Rectangle
rl forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Int32
X.rect_y Rectangle
rl)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
ascent, Int32
descent)