From 54cf675f1299a74466950be240a708a762335d5d Mon Sep 17 00:00:00 2001 From: jao Date: Sun, 25 Nov 2018 22:56:55 +0000 Subject: X11.XUtil -> X11.Text --- src/Xmobar/App/EventLoop.hs | 2 +- src/Xmobar/App/Main.hs | 2 +- src/Xmobar/X11/Draw.hs | 2 +- src/Xmobar/X11/Text.hs | 129 ++++++++++++++++++++++++++++++++++++++++++++ src/Xmobar/X11/Types.hs | 2 +- src/Xmobar/X11/Window.hs | 2 +- src/Xmobar/X11/XUtil.hs | 129 -------------------------------------------- 7 files changed, 134 insertions(+), 134 deletions(-) create mode 100644 src/Xmobar/X11/Text.hs delete mode 100644 src/Xmobar/X11/XUtil.hs (limited to 'src/Xmobar') diff --git a/src/Xmobar/App/EventLoop.hs b/src/Xmobar/App/EventLoop.hs index c751511..8da617b 100644 --- a/src/Xmobar/App/EventLoop.hs +++ b/src/Xmobar/App/EventLoop.hs @@ -44,7 +44,7 @@ import Xmobar.Run.Commands import Xmobar.Run.Runnable import Xmobar.X11.Parsers import Xmobar.X11.Window -import Xmobar.X11.XUtil +import Xmobar.X11.Text import Xmobar.X11.Draw import Xmobar.X11.Bitmap as Bitmap import Xmobar.X11.Types diff --git a/src/Xmobar/App/Main.hs b/src/Xmobar/App/Main.hs index b180e39..34d73e5 100644 --- a/src/Xmobar/App/Main.hs +++ b/src/Xmobar/App/Main.hs @@ -28,7 +28,7 @@ import Xmobar.Config.Types import Xmobar.System.Signal (setupSignalHandler, withDeferSignals) import Xmobar.Run.Template import Xmobar.X11.Types -import Xmobar.X11.XUtil +import Xmobar.X11.Text import Xmobar.X11.Window import Xmobar.App.EventLoop (startLoop, startCommand) diff --git a/src/Xmobar/X11/Draw.hs b/src/Xmobar/X11/Draw.hs index 246eb84..e9be1fe 100644 --- a/src/Xmobar/X11/Draw.hs +++ b/src/Xmobar/X11/Draw.hs @@ -33,7 +33,7 @@ import Xmobar.Config.Types import qualified Xmobar.X11.Bitmap as B import Xmobar.X11.Actions (Action(..)) import Xmobar.X11.Types -import Xmobar.X11.XUtil +import Xmobar.X11.Text import Xmobar.X11.ColorCache import Xmobar.X11.Window (drawBorder) import Xmobar.X11.Parsers (Widget(..)) diff --git a/src/Xmobar/X11/Text.hs b/src/Xmobar/X11/Text.hs new file mode 100644 index 0000000..6466009 --- /dev/null +++ b/src/Xmobar/X11/Text.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE CPP #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Xmobar.X11.Text +-- Copyright : (C) 2011, 2012, 2013, 2014, 2015, 2017, 2018 Jose Antonio Ortega Ruiz +-- (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : jao@gnu.org +-- Stability : unstable +-- Portability : unportable +-- +----------------------------------------------------------------------------- + +module Xmobar.X11.Text + ( XFont(..) + , initFont + , initCoreFont + , initUtf8Font + , textExtents + , textWidth + ) where + +import Control.Exception (SomeException, handle) +import Data.List +import Foreign +import Graphics.X11.Xlib hiding (textExtents, textWidth) +import qualified Graphics.X11.Xlib as Xlib (textExtents, textWidth) +import Graphics.X11.Xlib.Extras +import System.Mem.Weak ( addFinalizer ) + +#if defined XFT +import Xmobar.X11.MinXft +import Graphics.X11.Xrender +#else +import System.IO(hPutStrLn, stderr) +#endif + +data XFont = Core FontStruct + | Utf8 FontSet +#ifdef XFT + | Xft [AXftFont] +#endif + +-- | When initFont gets a font name that starts with 'xft:' it switchs +-- to the Xft backend Example: 'xft:Sans-10' +initFont :: Display -> String -> IO XFont +initFont d s = + let xftPrefix = "xft:" in + if xftPrefix `isPrefixOf` s then +#ifdef XFT + fmap Xft $ initXftFont d s +#else + do + hPutStrLn stderr $ "Warning: Xmobar must be built with " + ++ "the with_xft flag to support font '" ++ s + ++ ".' Falling back on default." + initFont d miscFixedFont +#endif + else + fmap Utf8 $ initUtf8Font d s + +miscFixedFont :: String +miscFixedFont = "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*" + +-- | Given a fontname returns the font structure. If the font name is +-- not valid the default font will be loaded and returned. +initCoreFont :: Display -> String -> IO FontStruct +initCoreFont d s = do + f <- handle fallBack getIt + addFinalizer f (freeFont d f) + return f + where getIt = loadQueryFont d s + fallBack :: SomeException -> IO FontStruct + fallBack = const $ loadQueryFont d miscFixedFont + +-- | Given a fontname returns the font structure. If the font name is +-- not valid the default font will be loaded and returned. +initUtf8Font :: Display -> String -> IO FontSet +initUtf8Font d s = do + (_,_,f) <- handle fallBack getIt + addFinalizer f (freeFontSet d f) + return f + where getIt = createFontSet d s + fallBack :: SomeException -> IO ([String], String, FontSet) + fallBack = const $ createFontSet d miscFixedFont + +#ifdef XFT +initXftFont :: Display -> String -> IO [AXftFont] +initXftFont d s = do + let fontNames = wordsBy (== ',') (drop 4 s) + mapM openFont fontNames + where + openFont fontName = do + f <- openAXftFont d (defaultScreenOfDisplay d) fontName + addFinalizer f (closeAXftFont d f) + return f + wordsBy p str = case dropWhile p str of + "" -> [] + str' -> w : wordsBy p str'' + where + (w, str'') = break p str' +#endif + +textWidth :: Display -> XFont -> String -> IO Int +textWidth _ (Utf8 fs) s = return $ fromIntegral $ wcTextEscapement fs s +textWidth _ (Core fs) s = return $ fromIntegral $ Xlib.textWidth fs s +#ifdef XFT +textWidth dpy (Xft xftdraw) s = do + gi <- xftTxtExtents' dpy xftdraw s + return $ xglyphinfo_xOff gi +#endif + +textExtents :: XFont -> String -> IO (Int32,Int32) +textExtents (Core fs) s = do + let (_,a,d,_) = Xlib.textExtents fs s + return (a,d) +textExtents (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) +#ifdef XFT +textExtents (Xft xftfonts) _ = do + ascent <- fromIntegral `fmap` xft_ascent' xftfonts + descent <- fromIntegral `fmap` xft_descent' xftfonts + return (ascent, descent) +#endif diff --git a/src/Xmobar/X11/Types.hs b/src/Xmobar/X11/Types.hs index f551c2a..333dc96 100644 --- a/src/Xmobar/X11/Types.hs +++ b/src/Xmobar/X11/Types.hs @@ -22,7 +22,7 @@ import Control.Monad.Reader import Data.Map import Xmobar.X11.Bitmap -import Xmobar.X11.XUtil +import Xmobar.X11.Text import Xmobar.Config.Types -- | The X type is a ReaderT diff --git a/src/Xmobar/X11/Window.hs b/src/Xmobar/X11/Window.hs index 23568ab..b8f56c6 100644 --- a/src/Xmobar/X11/Window.hs +++ b/src/Xmobar/X11/Window.hs @@ -29,7 +29,7 @@ import Data.Maybe (fromMaybe) import System.Posix.Process (getProcessID) import Xmobar.Config.Types -import Xmobar.X11.XUtil +import Xmobar.X11.Text -- $window diff --git a/src/Xmobar/X11/XUtil.hs b/src/Xmobar/X11/XUtil.hs deleted file mode 100644 index 6e9eb2b..0000000 --- a/src/Xmobar/X11/XUtil.hs +++ /dev/null @@ -1,129 +0,0 @@ -{-# LANGUAGE CPP #-} - ------------------------------------------------------------------------------ --- | --- Module : XUtil --- Copyright : (C) 2011, 2012, 2013, 2014, 2015, 2017, 2018 Jose Antonio Ortega Ruiz --- (C) 2007 Andrea Rossato --- License : BSD3 --- --- Maintainer : jao@gnu.org --- Stability : unstable --- Portability : unportable --- ------------------------------------------------------------------------------ - -module Xmobar.X11.XUtil - ( XFont(..) - , initFont - , initCoreFont - , initUtf8Font - , textExtents - , textWidth - ) where - -import Control.Exception (SomeException, handle) -import Data.List -import Foreign -import Graphics.X11.Xlib hiding (textExtents, textWidth) -import qualified Graphics.X11.Xlib as Xlib (textExtents, textWidth) -import Graphics.X11.Xlib.Extras -import System.Mem.Weak ( addFinalizer ) - -#if defined XFT -import Xmobar.X11.MinXft -import Graphics.X11.Xrender -#else -import System.IO(hPutStrLn, stderr) -#endif - -data XFont = Core FontStruct - | Utf8 FontSet -#ifdef XFT - | Xft [AXftFont] -#endif - --- | When initFont gets a font name that starts with 'xft:' it switchs --- to the Xft backend Example: 'xft:Sans-10' -initFont :: Display -> String -> IO XFont -initFont d s = - let xftPrefix = "xft:" in - if xftPrefix `isPrefixOf` s then -#ifdef XFT - fmap Xft $ initXftFont d s -#else - do - hPutStrLn stderr $ "Warning: Xmobar must be built with " - ++ "the with_xft flag to support font '" ++ s - ++ ".' Falling back on default." - initFont d miscFixedFont -#endif - else - fmap Utf8 $ initUtf8Font d s - -miscFixedFont :: String -miscFixedFont = "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*" - --- | Given a fontname returns the font structure. If the font name is --- not valid the default font will be loaded and returned. -initCoreFont :: Display -> String -> IO FontStruct -initCoreFont d s = do - f <- handle fallBack getIt - addFinalizer f (freeFont d f) - return f - where getIt = loadQueryFont d s - fallBack :: SomeException -> IO FontStruct - fallBack = const $ loadQueryFont d miscFixedFont - --- | Given a fontname returns the font structure. If the font name is --- not valid the default font will be loaded and returned. -initUtf8Font :: Display -> String -> IO FontSet -initUtf8Font d s = do - (_,_,f) <- handle fallBack getIt - addFinalizer f (freeFontSet d f) - return f - where getIt = createFontSet d s - fallBack :: SomeException -> IO ([String], String, FontSet) - fallBack = const $ createFontSet d miscFixedFont - -#ifdef XFT -initXftFont :: Display -> String -> IO [AXftFont] -initXftFont d s = do - let fontNames = wordsBy (== ',') (drop 4 s) - mapM openFont fontNames - where - openFont fontName = do - f <- openAXftFont d (defaultScreenOfDisplay d) fontName - addFinalizer f (closeAXftFont d f) - return f - wordsBy p str = case dropWhile p str of - "" -> [] - str' -> w : wordsBy p str'' - where - (w, str'') = break p str' -#endif - -textWidth :: Display -> XFont -> String -> IO Int -textWidth _ (Utf8 fs) s = return $ fromIntegral $ wcTextEscapement fs s -textWidth _ (Core fs) s = return $ fromIntegral $ Xlib.textWidth fs s -#ifdef XFT -textWidth dpy (Xft xftdraw) s = do - gi <- xftTxtExtents' dpy xftdraw s - return $ xglyphinfo_xOff gi -#endif - -textExtents :: XFont -> String -> IO (Int32,Int32) -textExtents (Core fs) s = do - let (_,a,d,_) = Xlib.textExtents fs s - return (a,d) -textExtents (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) -#ifdef XFT -textExtents (Xft xftfonts) _ = do - ascent <- fromIntegral `fmap` xft_ascent' xftfonts - descent <- fromIntegral `fmap` xft_descent' xftfonts - return (ascent, descent) -#endif -- cgit v1.2.3