{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
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
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
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
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
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
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
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
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"