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

------------------------------------------------------------------------------
-- |
-- Module: Xmobar.X11.Draw
-- Copyright: (c) 2018, 2020 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)
import Graphics.X11.Xlib.Extras

import Xmobar.Config.Types
import qualified Xmobar.X11.Bitmap as B
import Xmobar.X11.Actions (Action(..))
import Xmobar.X11.Types
import Xmobar.X11.Text
import Xmobar.X11.ColorCache
import Xmobar.X11.Window (drawBorder)
import Xmobar.X11.Parsers hiding (parseString)
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 -> [[(Widget, TextRenderInfo, Int, Maybe [Action])]] -> X ()
drawInWin :: Rectangle
-> [[(Widget, TextRenderInfo, Int, Maybe [Action])]] -> X ()
drawInWin wr :: Rectangle
wr@(Rectangle Position
_ Position
_ Dimension
wid Dimension
ht) ~[[(Widget, TextRenderInfo, Int, Maybe [Action])]
left,[(Widget, TextRenderInfo, Int, Maybe [Action])]
center,[(Widget, TextRenderInfo, Int, Maybe [Action])]
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)

  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
#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
=<< [(Widget, TextRenderInfo, Int, Maybe [Action])]
-> ReaderT XConf IO [(Widget, TextRenderInfo, Int, Position)]
forall b d.
[(Widget, b, Int, d)]
-> ReaderT XConf IO [(Widget, b, Int, Position)]
strLn [(Widget, TextRenderInfo, Int, Maybe [Action])]
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
=<< [(Widget, TextRenderInfo, Int, Maybe [Action])]
-> ReaderT XConf IO [(Widget, TextRenderInfo, Int, Position)]
forall b d.
[(Widget, b, Int, d)]
-> ReaderT XConf IO [(Widget, b, Int, Position)]
strLn [(Widget, TextRenderInfo, Int, Maybe [Action])]
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
=<< [(Widget, TextRenderInfo, Int, Maybe [Action])]
-> ReaderT XConf IO [(Widget, TextRenderInfo, Int, Position)]
forall b d.
[(Widget, b, Int, d)]
-> ReaderT XConf IO [(Widget, b, Int, Position)]
strLn [(Widget, TextRenderInfo, Int, Maybe [Action])]
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
    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
False

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

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) = case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') (TextRenderInfo -> FilePath
tColorsString TextRenderInfo
c) of
                 (FilePath
f,Char
',':FilePath
b) -> (FilePath
f, FilePath
b           )
                 (FilePath
f,    FilePath
_) -> (FilePath
f, Config -> FilePath
bgColor Config
conf)
  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))
  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"