{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}

------------------------------------------------------------------------------
-- |
-- Module: Xmobar.X11.Draw
-- Copyright: (c) 2018, 2020, 2022 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Sat Nov 24, 2018 18:49
--
--
-- Drawing the xmobar contents
--
------------------------------------------------------------------------------


module Xmobar.X11.Draw (drawInWin) where

import Prelude hiding (lookup)
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Arrow ((&&&))
import Data.Map hiding ((\\), foldr, map, filter)
import Data.List ((\\))
import qualified Data.List.NonEmpty as NE

import Graphics.X11.Xlib hiding (textExtents, textWidth, Segment)
import Graphics.X11.Xlib.Extras

import Xmobar.Config.Types
import Xmobar.Run.Parsers hiding (parseString)
import qualified Xmobar.X11.Bitmap as B
import Xmobar.X11.Types
import Xmobar.X11.Text
import Xmobar.X11.ColorCache
import Xmobar.X11.Window (drawBorder)
import Xmobar.System.Utils (safeIndex)

#ifdef XFT
import Xmobar.X11.MinXft
import Graphics.X11.Xrender
#endif

fi :: (Integral a, Num b) => a -> b
fi :: a -> b
fi = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Draws in and updates the window
drawInWin :: Rectangle -> [[Segment]] -> X ()
drawInWin :: Rectangle -> [[Segment]] -> X ()
drawInWin wr :: Rectangle
wr@(Rectangle Position
_ Position
_ Dimension
wid Dimension
ht) ~[[Segment]
left,[Segment]
center,[Segment]
right] = do
  XConf
r <- ReaderT XConf IO XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
  let (Config
c,Display
d) = (XConf -> Config
config (XConf -> Config)
-> (XConf -> Display) -> XConf -> (Config, Display)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& XConf -> Display
display) XConf
r
      (Window
w,(NonEmpty XFont
fs,NonEmpty Int
vs)) = (XConf -> Window
window (XConf -> Window)
-> (XConf -> (NonEmpty XFont, NonEmpty Int))
-> XConf
-> (Window, (NonEmpty XFont, NonEmpty Int))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& XConf -> NonEmpty XFont
fontListS (XConf -> NonEmpty XFont)
-> (XConf -> NonEmpty Int)
-> XConf
-> (NonEmpty XFont, NonEmpty Int)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& XConf -> NonEmpty Int
verticalOffsets) XConf
r
      strLn :: [(Widget, b, Int, d)]
-> ReaderT XConf IO [(Widget, b, Int, Position)]
strLn = IO [(Widget, b, Int, Position)]
-> ReaderT XConf IO [(Widget, b, Int, Position)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Widget, b, Int, Position)]
 -> ReaderT XConf IO [(Widget, b, Int, Position)])
-> ([(Widget, b, Int, d)] -> IO [(Widget, b, Int, Position)])
-> [(Widget, b, Int, d)]
-> ReaderT XConf IO [(Widget, b, Int, Position)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Widget, b, Int, d) -> IO (Widget, b, Int, Position))
-> [(Widget, b, Int, d)] -> IO [(Widget, b, Int, Position)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Widget, b, Int, d) -> IO (Widget, b, Int, Position)
forall d b d.
Num d =>
(Widget, b, Int, d) -> IO (Widget, b, Int, d)
getWidth
      iconW :: FilePath -> Dimension
iconW FilePath
i = Dimension -> (Bitmap -> Dimension) -> Maybe Bitmap -> Dimension
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Dimension
0 Bitmap -> Dimension
B.width (FilePath -> Map FilePath Bitmap -> Maybe Bitmap
forall k a. Ord k => k -> Map k a -> Maybe a
lookup FilePath
i (Map FilePath Bitmap -> Maybe Bitmap)
-> Map FilePath Bitmap -> Maybe Bitmap
forall a b. (a -> b) -> a -> b
$ XConf -> Map FilePath Bitmap
iconS XConf
r)
      getWidth :: (Widget, b, Int, d) -> IO (Widget, b, Int, d)
getWidth (Text FilePath
s,b
cl,Int
i,d
_) =
        Display -> XFont -> FilePath -> IO Int
textWidth Display
d (NonEmpty XFont -> Int -> XFont
forall a. NonEmpty a -> Int -> a
safeIndex NonEmpty XFont
fs Int
i) FilePath
s IO Int -> (Int -> IO (Widget, b, Int, d)) -> IO (Widget, b, Int, d)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
tw -> (Widget, b, Int, d) -> IO (Widget, b, Int, d)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Widget
Text FilePath
s,b
cl,Int
i,Int -> d
forall a b. (Integral a, Num b) => a -> b
fi Int
tw)
      getWidth (Icon FilePath
s,b
cl,Int
i,d
_) = (Widget, b, Int, d) -> IO (Widget, b, Int, d)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Widget
Icon FilePath
s,b
cl,Int
i,Dimension -> d
forall a b. (Integral a, Num b) => a -> b
fi (Dimension -> d) -> Dimension -> d
forall a b. (a -> b) -> a -> b
$ FilePath -> Dimension
iconW FilePath
s)
      getWidth (Hspace Position
p,b
cl,Int
i,d
_) = (Widget, b, Int, d) -> IO (Widget, b, Int, d)
forall (m :: * -> *) a. Monad m => a -> m a
return (Position -> Widget
Hspace Position
p,b
cl,Int
i,Position -> d
forall a b. (Integral a, Num b) => a -> b
fi Position
p)

  Window
p <- IO Window -> ReaderT XConf IO Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Window -> ReaderT XConf IO Window)
-> IO Window -> ReaderT XConf IO Window
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Dimension -> Dimension -> CInt -> IO Window
createPixmap Display
d Window
w Dimension
wid Dimension
ht
                         (Screen -> CInt
defaultDepthOfScreen (Display -> Screen
defaultScreenOfDisplay Display
d))
#if XFT
  when (alpha c /= 255) (liftIO $ drawBackground d p (bgColor c) (alpha c) wr)
#else
  Rectangle
_ <- Rectangle -> ReaderT XConf IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
wr
#endif
  Display -> [FilePath] -> ([Window] -> X ()) -> X ()
forall (m :: * -> *) a.
MonadIO m =>
Display -> [FilePath] -> ([Window] -> m a) -> m a
withColors Display
d [Config -> FilePath
bgColor Config
c, Config -> FilePath
borderColor Config
c] (([Window] -> X ()) -> X ()) -> ([Window] -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \[Window
bgcolor, Window
bdcolor] -> do
    GC
gc <- IO GC -> ReaderT XConf IO GC
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GC -> ReaderT XConf IO GC) -> IO GC -> ReaderT XConf IO GC
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO GC
createGC  Display
d Window
w
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> GC -> Bool -> IO ()
setGraphicsExposures Display
d GC
gc Bool
False
#if XFT
    when (alpha c == 255) $ do
#else
    do
#endif
      IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> GC -> Window -> IO ()
setForeground Display
d GC
gc Window
bgcolor
      IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
fillRectangle Display
d Window
p GC
gc Position
0 Position
0 Dimension
wid Dimension
ht
    -- write to the pixmap the new string
    Window
-> GC
-> NonEmpty XFont
-> NonEmpty Int
-> Position
-> Align
-> [((Position, Position), Box)]
-> [(Widget, TextRenderInfo, Int, Position)]
-> X ()
printStrings Window
p GC
gc NonEmpty XFont
fs NonEmpty Int
vs Position
1 Align
L [] ([(Widget, TextRenderInfo, Int, Position)] -> X ())
-> ReaderT XConf IO [(Widget, TextRenderInfo, Int, Position)]
-> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Segment]
-> ReaderT XConf IO [(Widget, TextRenderInfo, Int, Position)]
forall b d.
[(Widget, b, Int, d)]
-> ReaderT XConf IO [(Widget, b, Int, Position)]
strLn [Segment]
left
    Window
-> GC
-> NonEmpty XFont
-> NonEmpty Int
-> Position
-> Align
-> [((Position, Position), Box)]
-> [(Widget, TextRenderInfo, Int, Position)]
-> X ()
printStrings Window
p GC
gc NonEmpty XFont
fs NonEmpty Int
vs Position
1 Align
R [] ([(Widget, TextRenderInfo, Int, Position)] -> X ())
-> ReaderT XConf IO [(Widget, TextRenderInfo, Int, Position)]
-> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Segment]
-> ReaderT XConf IO [(Widget, TextRenderInfo, Int, Position)]
forall b d.
[(Widget, b, Int, d)]
-> ReaderT XConf IO [(Widget, b, Int, Position)]
strLn [Segment]
right
    Window
-> GC
-> NonEmpty XFont
-> NonEmpty Int
-> Position
-> Align
-> [((Position, Position), Box)]
-> [(Widget, TextRenderInfo, Int, Position)]
-> X ()
printStrings Window
p GC
gc NonEmpty XFont
fs NonEmpty Int
vs Position
1 Align
C [] ([(Widget, TextRenderInfo, Int, Position)] -> X ())
-> ReaderT XConf IO [(Widget, TextRenderInfo, Int, Position)]
-> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Segment]
-> ReaderT XConf IO [(Widget, TextRenderInfo, Int, Position)]
forall b d.
[(Widget, b, Int, d)]
-> ReaderT XConf IO [(Widget, b, Int, Position)]
strLn [Segment]
center
    -- draw border if requested
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Border
-> Int
-> Display
-> Window
-> GC
-> Window
-> Dimension
-> Dimension
-> IO ()
drawBorder (Config -> Border
border Config
c) (Config -> Int
borderWidth Config
c) Display
d Window
p GC
gc Window
bdcolor Dimension
wid Dimension
ht
    -- copy the pixmap with the new string to the window
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> Window
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> Position
-> Position
-> IO ()
copyArea Display
d Window
p Window
w GC
gc Position
0 Position
0 Dimension
wid Dimension
ht Position
0 Position
0
    -- free up everything (we do not want to leak memory!)
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> GC -> IO ()
freeGC Display
d GC
gc
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ()
freePixmap Display
d Window
p
    -- resync (discard events, we don't read/process events from this display conn)
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Bool -> IO ()
sync Display
d Bool
True

verticalOffset :: (Integral b, Integral a, MonadIO m) =>
                  a -> Widget -> XFont -> Int -> Config -> m b
verticalOffset :: a -> Widget -> XFont -> Int -> Config -> m b
verticalOffset a
ht (Text FilePath
t) XFont
fontst Int
voffs Config
_
  | Int
voffs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> -Int
1 = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ Int -> b
forall a b. (Integral a, Num b) => a -> b
fi Int
voffs
  | Bool
otherwise = do
     (Position
as,Position
ds) <- IO (Position, Position) -> m (Position, Position)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Position, Position) -> m (Position, Position))
-> IO (Position, Position) -> m (Position, Position)
forall a b. (a -> b) -> a -> b
$ XFont -> FilePath -> IO (Position, Position)
textExtents XFont
fontst FilePath
t
     let margin :: b
margin = (a -> b
forall a b. (Integral a, Num b) => a -> b
fi a
ht b -> b -> b
forall a. Num a => a -> a -> a
- Position -> b
forall a b. (Integral a, Num b) => a -> b
fi Position
ds b -> b -> b
forall a. Num a => a -> a -> a
- Position -> b
forall a b. (Integral a, Num b) => a -> b
fi Position
as) b -> b -> b
forall a. Integral a => a -> a -> a
`div` b
2
     b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ Position -> b
forall a b. (Integral a, Num b) => a -> b
fi Position
as b -> b -> b
forall a. Num a => a -> a -> a
+ b
margin b -> b -> b
forall a. Num a => a -> a -> a
- b
1
verticalOffset a
ht (Icon FilePath
_) XFont
_ Int
_ Config
conf
  | Config -> Int
iconOffset Config
conf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> -Int
1 = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ Int -> b
forall a b. (Integral a, Num b) => a -> b
fi (Config -> Int
iconOffset Config
conf)
  | Bool
otherwise = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ a -> b
forall a b. (Integral a, Num b) => a -> b
fi (a
ht a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2) b -> b -> b
forall a. Num a => a -> a -> a
- b
1
verticalOffset a
_ (Hspace Position
_) XFont
_ Int
voffs Config
_ = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ Int -> b
forall a b. (Integral a, Num b) => a -> b
fi Int
voffs

printString :: Display
            -> Drawable
            -> XFont
            -> GC
            -> String
            -> String
            -> Position
            -> Position
            -> Position
            -> Position
            -> String
            -> Int
            -> IO ()
printString :: Display
-> Window
-> XFont
-> GC
-> FilePath
-> FilePath
-> Position
-> Position
-> Position
-> Position
-> FilePath
-> Int
-> IO ()
printString Display
d Window
p (Core FontStruct
fs) GC
gc FilePath
fc FilePath
bc Position
x Position
y Position
_ Position
_ FilePath
s Int
a = do
    Display -> GC -> Window -> IO ()
setFont Display
d GC
gc (Window -> IO ()) -> Window -> IO ()
forall a b. (a -> b) -> a -> b
$ FontStruct -> Window
fontFromFontStruct FontStruct
fs
    Display -> [FilePath] -> ([Window] -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Display -> [FilePath] -> ([Window] -> m a) -> m a
withColors Display
d [FilePath
fc, FilePath
bc] (([Window] -> IO ()) -> IO ()) -> ([Window] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Window
fc', Window
bc'] -> do
      Display -> GC -> Window -> IO ()
setForeground Display
d GC
gc Window
fc'
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
255) (Display -> GC -> Window -> IO ()
setBackground Display
d GC
gc Window
bc')
      Display
-> Window -> GC -> Position -> Position -> FilePath -> IO ()
drawImageString Display
d Window
p GC
gc Position
x Position
y FilePath
s

printString Display
d Window
p (Utf8 FontSet
fs) GC
gc FilePath
fc FilePath
bc Position
x Position
y Position
_ Position
_ FilePath
s Int
a =
    Display -> [FilePath] -> ([Window] -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Display -> [FilePath] -> ([Window] -> m a) -> m a
withColors Display
d [FilePath
fc, FilePath
bc] (([Window] -> IO ()) -> IO ()) -> ([Window] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Window
fc', Window
bc'] -> do
      Display -> GC -> Window -> IO ()
setForeground Display
d GC
gc Window
fc'
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
255) (Display -> GC -> Window -> IO ()
setBackground Display
d GC
gc Window
bc')
      IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> FontSet
-> GC
-> Position
-> Position
-> FilePath
-> IO ()
wcDrawImageString Display
d Window
p FontSet
fs GC
gc Position
x Position
y FilePath
s

#ifdef XFT
printString dpy drw fs@(Xft fonts) _ fc bc x y ay ht s al =
  withDrawingColors dpy drw fc bc $ \draw fc' bc' -> do
    when (al == 255) $ do
      (a,d)  <- textExtents fs s
      gi <- xftTxtExtents' dpy fonts s
      if ay < 0
        then drawXftRect draw bc' x (y - a) (1 + xglyphinfo_xOff gi) (a + d + 2)
        else drawXftRect draw bc' x ay (1 + xglyphinfo_xOff gi) ht
    drawXftString' draw fc' fonts (toInteger x) (toInteger y) s
#endif

-- | An easy way to print the stuff we need to print
printStrings :: Drawable
             -> GC
             -> NE.NonEmpty XFont
             -> NE.NonEmpty Int
             -> Position
             -> Align
             -> [((Position, Position), Box)]
             -> [(Widget, TextRenderInfo, Int, Position)] -> X ()
printStrings :: Window
-> GC
-> NonEmpty XFont
-> NonEmpty Int
-> Position
-> Align
-> [((Position, Position), Box)]
-> [(Widget, TextRenderInfo, Int, Position)]
-> X ()
printStrings Window
_ GC
_ NonEmpty XFont
_ NonEmpty Int
_ Position
_ Align
_ [((Position, Position), Box)]
_ [] = () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
printStrings Window
dr GC
gc NonEmpty XFont
fontlist NonEmpty Int
voffs Position
offs Align
a [((Position, Position), Box)]
boxes sl :: [(Widget, TextRenderInfo, Int, Position)]
sl@((Widget
s,TextRenderInfo
c,Int
i,Position
l):[(Widget, TextRenderInfo, Int, Position)]
xs) = do
  XConf
r <- ReaderT XConf IO XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
  let (Config
conf,Display
d) = (XConf -> Config
config (XConf -> Config)
-> (XConf -> Display) -> XConf -> (Config, Display)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& XConf -> Display
display) XConf
r
      alph :: Int
alph = Config -> Int
alpha Config
conf
      Rectangle Position
_ Position
_ Dimension
wid Dimension
ht = XConf -> Rectangle
rect XConf
r
      totSLen :: Position
totSLen = ((Widget, TextRenderInfo, Int, Position) -> Position -> Position)
-> Position
-> [(Widget, TextRenderInfo, Int, Position)]
-> Position
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Widget
_,TextRenderInfo
_,Int
_,Position
len) -> Position -> Position -> Position
forall a. Num a => a -> a -> a
(+) Position
len) Position
0 [(Widget, TextRenderInfo, Int, Position)]
sl
      remWidth :: Position
remWidth = Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
wid Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position -> Position
forall a b. (Integral a, Num b) => a -> b
fi Position
totSLen
      fontst :: XFont
fontst = NonEmpty XFont -> Int -> XFont
forall a. NonEmpty a -> Int -> a
safeIndex NonEmpty XFont
fontlist Int
i
      voff :: Int
voff = NonEmpty Int -> Int -> Int
forall a. NonEmpty a -> Int -> a
safeIndex NonEmpty Int
voffs Int
i
      offset :: Position
offset = case Align
a of
                 Align
C -> (Position
remWidth Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
offs) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2
                 Align
R -> Position
remWidth
                 Align
L -> Position
offs
      (FilePath
fc,FilePath
bc) = Config -> FilePath -> (FilePath, FilePath)
colorComponents Config
conf (TextRenderInfo -> FilePath
tColorsString TextRenderInfo
c)
  Position
valign <- Dimension
-> Widget -> XFont -> Int -> Config -> ReaderT XConf IO Position
forall b a (m :: * -> *).
(Integral b, Integral a, MonadIO m) =>
a -> Widget -> XFont -> Int -> Config -> m b
verticalOffset Dimension
ht Widget
s XFont
fontst Int
voff Config
conf
  let (Position
ht',Position
ay) = case (TextRenderInfo -> Position
tBgTopOffset TextRenderInfo
c, TextRenderInfo -> Position
tBgBottomOffset TextRenderInfo
c) of
                   (-1,Position
_)  -> (Position
0, -Position
1)
                   (Position
_,-1)  -> (Position
0, -Position
1)
                   (Position
ot,Position
ob) -> (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
ht Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
ot Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
ob, Position
ob)
  case Widget
s of
    (Text FilePath
t) -> IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> XFont
-> GC
-> FilePath
-> FilePath
-> Position
-> Position
-> Position
-> Position
-> FilePath
-> Int
-> IO ()
printString Display
d Window
dr XFont
fontst GC
gc FilePath
fc FilePath
bc Position
offset Position
valign Position
ay Position
ht' FilePath
t Int
alph
    (Icon FilePath
p) -> IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ IO () -> (Bitmap -> IO ()) -> Maybe Bitmap -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                           (Display
-> Window
-> GC
-> FilePath
-> FilePath
-> Position
-> Position
-> Bitmap
-> IO ()
B.drawBitmap Display
d Window
dr GC
gc FilePath
fc FilePath
bc Position
offset Position
valign)
                           (FilePath -> Map FilePath Bitmap -> Maybe Bitmap
forall k a. Ord k => k -> Map k a -> Maybe a
lookup FilePath
p (XConf -> Map FilePath Bitmap
iconS XConf
r))
    (Hspace Position
_) -> IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  let triBoxes :: [Box]
triBoxes = TextRenderInfo -> [Box]
tBoxes TextRenderInfo
c
      dropBoxes :: [((Position, Position), Box)]
dropBoxes = (((Position, Position), Box) -> Bool)
-> [((Position, Position), Box)] -> [((Position, Position), Box)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\((Position, Position)
_,Box
b) -> Box
b Box -> [Box] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Box]
triBoxes) [((Position, Position), Box)]
boxes
      boxes' :: [((Position, Position), Box)]
boxes' = (((Position, Position), Box) -> ((Position, Position), Box))
-> [((Position, Position), Box)] -> [((Position, Position), Box)]
forall a b. (a -> b) -> [a] -> [b]
map (\((Position
x1,Position
_),Box
b) -> ((Position
x1, Position
offset Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
l), Box
b))
                   ((((Position, Position), Box) -> Bool)
-> [((Position, Position), Box)] -> [((Position, Position), Box)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\((Position, Position)
_,Box
b) -> Box
b Box -> [Box] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Box]
triBoxes) [((Position, Position), Box)]
boxes)
            [((Position, Position), Box)]
-> [((Position, Position), Box)] -> [((Position, Position), Box)]
forall a. [a] -> [a] -> [a]
++ (Box -> ((Position, Position), Box))
-> [Box] -> [((Position, Position), Box)]
forall a b. (a -> b) -> [a] -> [b]
map ((Position
offset, Position
offset Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
l),) ([Box]
triBoxes [Box] -> [Box] -> [Box]
forall a. Eq a => [a] -> [a] -> [a]
\\ (((Position, Position), Box) -> Box)
-> [((Position, Position), Box)] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map ((Position, Position), Box) -> Box
forall a b. (a, b) -> b
snd [((Position, Position), Box)]
boxes)
  if [(Widget, TextRenderInfo, Int, Position)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [(Widget, TextRenderInfo, Int, Position)]
xs
    then IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> GC
-> Position
-> [((Position, Position), Box)]
-> IO ()
drawBoxes Display
d Window
dr GC
gc (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
ht) ([((Position, Position), Box)]
dropBoxes [((Position, Position), Box)]
-> [((Position, Position), Box)] -> [((Position, Position), Box)]
forall a. [a] -> [a] -> [a]
++ [((Position, Position), Box)]
boxes')
    else IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> GC
-> Position
-> [((Position, Position), Box)]
-> IO ()
drawBoxes Display
d Window
dr GC
gc (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
ht) [((Position, Position), Box)]
dropBoxes
  Window
-> GC
-> NonEmpty XFont
-> NonEmpty Int
-> Position
-> Align
-> [((Position, Position), Box)]
-> [(Widget, TextRenderInfo, Int, Position)]
-> X ()
printStrings Window
dr GC
gc NonEmpty XFont
fontlist NonEmpty Int
voffs (Position
offs Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
l) Align
a [((Position, Position), Box)]
boxes' [(Widget, TextRenderInfo, Int, Position)]
xs

drawBoxes :: Display
          -> Drawable
          -> GC
          -> Position
          -> [((Position, Position), Box)]
          -> IO ()
drawBoxes :: Display
-> Window
-> GC
-> Position
-> [((Position, Position), Box)]
-> IO ()
drawBoxes Display
_ Window
_ GC
_ Position
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
drawBoxes Display
d Window
dr GC
gc Position
ht (((Position, Position), Box)
b:[((Position, Position), Box)]
bs) = do
  let ((Position, Position)
xx, Box BoxBorder
bb BoxOffset
offset CInt
lineWidth FilePath
fc BoxMargins
mgs) = ((Position, Position), Box)
b
      lw :: Position
lw = CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
lineWidth :: Position
  Display -> [FilePath] -> ([Window] -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
Display -> [FilePath] -> ([Window] -> m a) -> m a
withColors Display
d [FilePath
fc] (([Window] -> IO ()) -> IO ()) -> ([Window] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Window
fc'] -> do
    Display -> GC -> Window -> IO ()
setForeground Display
d GC
gc Window
fc'
    Display -> GC -> CInt -> CInt -> CInt -> CInt -> IO ()
setLineAttributes Display
d GC
gc CInt
lineWidth CInt
lineSolid CInt
capNotLast CInt
joinMiter
    case BoxBorder
bb of
      BoxBorder
BBVBoth -> do
        Display
-> Window
-> GC
-> BoxBorder
-> BoxOffset
-> Position
-> (Position, Position)
-> Position
-> BoxMargins
-> IO ()
drawBoxBorder Display
d Window
dr GC
gc BoxBorder
BBTop    BoxOffset
offset Position
ht (Position, Position)
xx Position
lw BoxMargins
mgs
        Display
-> Window
-> GC
-> BoxBorder
-> BoxOffset
-> Position
-> (Position, Position)
-> Position
-> BoxMargins
-> IO ()
drawBoxBorder Display
d Window
dr GC
gc BoxBorder
BBBottom BoxOffset
offset Position
ht (Position, Position)
xx Position
lw BoxMargins
mgs
      BoxBorder
BBHBoth -> do
        Display
-> Window
-> GC
-> BoxBorder
-> BoxOffset
-> Position
-> (Position, Position)
-> Position
-> BoxMargins
-> IO ()
drawBoxBorder Display
d Window
dr GC
gc BoxBorder
BBLeft   BoxOffset
offset Position
ht (Position, Position)
xx Position
lw BoxMargins
mgs
        Display
-> Window
-> GC
-> BoxBorder
-> BoxOffset
-> Position
-> (Position, Position)
-> Position
-> BoxMargins
-> IO ()
drawBoxBorder Display
d Window
dr GC
gc BoxBorder
BBRight  BoxOffset
offset Position
ht (Position, Position)
xx Position
lw BoxMargins
mgs
      BoxBorder
BBFull  -> do
        Display
-> Window
-> GC
-> BoxBorder
-> BoxOffset
-> Position
-> (Position, Position)
-> Position
-> BoxMargins
-> IO ()
drawBoxBorder Display
d Window
dr GC
gc BoxBorder
BBTop    BoxOffset
offset Position
ht (Position, Position)
xx Position
lw BoxMargins
mgs
        Display
-> Window
-> GC
-> BoxBorder
-> BoxOffset
-> Position
-> (Position, Position)
-> Position
-> BoxMargins
-> IO ()
drawBoxBorder Display
d Window
dr GC
gc BoxBorder
BBBottom BoxOffset
offset Position
ht (Position, Position)
xx Position
lw BoxMargins
mgs
        Display
-> Window
-> GC
-> BoxBorder
-> BoxOffset
-> Position
-> (Position, Position)
-> Position
-> BoxMargins
-> IO ()
drawBoxBorder Display
d Window
dr GC
gc BoxBorder
BBLeft   BoxOffset
offset Position
ht (Position, Position)
xx Position
lw BoxMargins
mgs
        Display
-> Window
-> GC
-> BoxBorder
-> BoxOffset
-> Position
-> (Position, Position)
-> Position
-> BoxMargins
-> IO ()
drawBoxBorder Display
d Window
dr GC
gc BoxBorder
BBRight  BoxOffset
offset Position
ht (Position, Position)
xx Position
lw BoxMargins
mgs
      BoxBorder
_ -> Display
-> Window
-> GC
-> BoxBorder
-> BoxOffset
-> Position
-> (Position, Position)
-> Position
-> BoxMargins
-> IO ()
drawBoxBorder Display
d Window
dr GC
gc BoxBorder
bb    BoxOffset
offset Position
ht (Position, Position)
xx Position
lw BoxMargins
mgs
  Display
-> Window
-> GC
-> Position
-> [((Position, Position), Box)]
-> IO ()
drawBoxes Display
d Window
dr GC
gc Position
ht [((Position, Position), Box)]
bs

drawBoxBorder :: Display
              -> Drawable
              -> GC
              -> BoxBorder
              -> BoxOffset
              -> Position
              -> (Position, Position)
              -> Position
              -> BoxMargins
              -> IO ()
drawBoxBorder :: Display
-> Window
-> GC
-> BoxBorder
-> BoxOffset
-> Position
-> (Position, Position)
-> Position
-> BoxMargins
-> IO ()
drawBoxBorder
  Display
d Window
dr GC
gc BoxBorder
pos (BoxOffset Align
alg Position
offset) Position
ht (Position
x1,Position
x2) Position
lw (BoxMargins Position
mt Position
mr Position
mb Position
ml) = do
  let (Position
p1,Position
p2) = case Align
alg of
                 Align
L -> (Position
0,      -Position
offset)
                 Align
C -> (Position
offset, -Position
offset)
                 Align
R -> (Position
offset, Position
0      )
      lc :: Position
lc = Position
lw Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2
  case BoxBorder
pos of
    BoxBorder
BBTop    -> Display
-> Window
-> GC
-> Position
-> Position
-> Position
-> Position
-> IO ()
drawLine Display
d Window
dr GC
gc (Position
x1 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
p1) (Position
mt Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
lc) (Position
x2 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
p2) (Position
mt Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
lc)
    BoxBorder
BBBottom -> do
      let lc' :: Position
lc' = Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
lc Position
1 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
mb
      Display
-> Window
-> GC
-> Position
-> Position
-> Position
-> Position
-> IO ()
drawLine Display
d Window
dr GC
gc (Position
x1 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
p1) (Position
ht Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
lc') (Position
x2 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
p2) (Position
ht Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
lc')
    BoxBorder
BBLeft   -> Display
-> Window
-> GC
-> Position
-> Position
-> Position
-> Position
-> IO ()
drawLine Display
d Window
dr GC
gc (Position
x1 Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
1 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
ml) Position
p1 (Position
x1 Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
1 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
ml) (Position
ht Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
p2)
    BoxBorder
BBRight  -> Display
-> Window
-> GC
-> Position
-> Position
-> Position
-> Position
-> IO ()
drawLine Display
d Window
dr GC
gc (Position
x2 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
lc Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
1 Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
mr) Position
p1 (Position
x2 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
lc Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
1 Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
mr) (Position
ht Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
p2)
    BoxBorder
_ -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"unreachable code"