{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Xmobar.X11.Text
-- Copyright   :  (C) 2011-2015, 2017, 2018, 2022 Jose Antonio Ortega Ruiz
--                (C) 2007 Andrea Rossato
-- License     :  BSD3
--
-- Maintainer  :  jao@gnu.org
-- Stability   :  unstable
-- Portability :  unportable
--
-----------------------------------------------------------------------------

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-*-*-*-*-*-*-*-*-*-*-*-*"

-- | Given a fontname returns the font structure. If the font name is
--  not valid the default font will be loaded and returned.
initUtf8Font :: X.Display -> String -> IO Xx.FontSet
initUtf8Font :: Display -> String -> IO XFont
initUtf8Font Display
d String
s = do
  (_,_,f) <- (SomeException -> IO ([String], String, XFont))
-> IO ([String], String, XFont) -> IO ([String], String, XFont)
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
  W.addFinalizer f (Xx.freeFontSet d f)
  return 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 = IO ([String], String, XFont)
-> SomeException -> IO ([String], String, XFont)
forall a b. a -> b -> a
const (IO ([String], String, XFont)
 -> SomeException -> IO ([String], String, XFont))
-> IO ([String], String, XFont)
-> SomeException
-> IO ([String], String, XFont)
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 = Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Int32 -> Int
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  = Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int32) -> Int32 -> Int32
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32
forall a. Num a => a -> a
negate (Rectangle -> Int32
X.rect_y Rectangle
rl)
      descent :: Int32
descent = Dimension -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension -> Int32) -> Dimension -> Int32
forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
X.rect_height Rectangle
rl Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Int32 -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Int32
X.rect_y Rectangle
rl)
  (Int32, Int32) -> IO (Int32, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
ascent, Int32
descent)