summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--src/Xmobar/X11/Draw.hs55
1 files changed, 43 insertions, 12 deletions
diff --git a/src/Xmobar/X11/Draw.hs b/src/Xmobar/X11/Draw.hs
index 6a9a5d8..6348a1a 100644
--- a/src/Xmobar/X11/Draw.hs
+++ b/src/Xmobar/X11/Draw.hs
@@ -28,11 +28,10 @@ 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 hiding (textExtents, textWidth, Segment)
import Graphics.X11.Xlib.Extras
import Xmobar.Config.Types
-import Xmobar.Run.Actions (Action(..))
import Xmobar.Run.Parsers hiding (parseString)
import qualified Xmobar.X11.Bitmap as B
import Xmobar.X11.Types
@@ -50,7 +49,7 @@ fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
-- | Draws in and updates the window
-drawInWin :: Rectangle -> [[(Widget, TextRenderInfo, Int, Maybe [Action])]] -> X ()
+drawInWin :: Rectangle -> [[Segment]] -> X ()
drawInWin wr@(Rectangle _ _ wid ht) ~[left,center,right] = do
r <- ask
let (c,d) = (config &&& display) r
@@ -105,8 +104,19 @@ verticalOffset ht (Icon _) _ _ conf
| otherwise = return $ fi (ht `div` 2) - 1
verticalOffset _ (Hspace _) _ voffs _ = return $ fi voffs
-printString :: Display -> Drawable -> XFont -> GC -> String -> String
- -> Position -> Position -> Position -> Position -> String -> Int -> IO ()
+printString :: Display
+ -> Drawable
+ -> XFont
+ -> GC
+ -> String
+ -> String
+ -> Position
+ -> Position
+ -> Position
+ -> Position
+ -> String
+ -> Int
+ -> IO ()
printString d p (Core fs) gc fc bc x y _ _ s a = do
setFont d gc $ fontFromFontStruct fs
withColors d [fc, bc] $ \[fc', bc'] -> do
@@ -133,8 +143,14 @@ printString dpy drw fs@(Xft fonts) _ fc bc x y ay ht s al =
#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 :: Drawable
+ -> GC
+ -> NE.NonEmpty XFont
+ -> NE.NonEmpty Int
+ -> Position
+ -> Align
+ -> [((Position, Position), Box)]
+ -> [(Widget, TextRenderInfo, Int, Position)] -> X ()
printStrings _ _ _ _ _ _ _ [] = return ()
printStrings dr gc fontlist voffs offs a boxes sl@((s,c,i,l):xs) = do
r <- ask
@@ -163,14 +179,20 @@ printStrings dr gc fontlist voffs offs a boxes sl@((s,c,i,l):xs) = do
(Hspace _) -> liftIO $ return ()
let triBoxes = tBoxes c
dropBoxes = filter (\(_,b) -> b `notElem` triBoxes) boxes
- boxes' = map (\((x1,_),b) -> ((x1, offset + l), b)) (filter (\(_,b) -> b `elem` triBoxes) boxes)
+ boxes' = map (\((x1,_),b) -> ((x1, offset + l), b))
+ (filter (\(_,b) -> b `elem` triBoxes) boxes)
++ map ((offset, offset + l),) (triBoxes \\ map snd boxes)
if Prelude.null xs
then liftIO $ drawBoxes d dr gc (fromIntegral ht) (dropBoxes ++ boxes')
else liftIO $ drawBoxes d dr gc (fromIntegral ht) dropBoxes
printStrings dr gc fontlist voffs (offs + l) a boxes' xs
-drawBoxes :: Display -> Drawable -> GC -> Position -> [((Position, Position), Box)] -> IO ()
+drawBoxes :: Display
+ -> Drawable
+ -> GC
+ -> Position
+ -> [((Position, Position), Box)]
+ -> IO ()
drawBoxes _ _ _ _ [] = return ()
drawBoxes d dr gc ht (b:bs) = do
let (xx, Box bb offset lineWidth fc mgs) = b
@@ -193,9 +215,18 @@ drawBoxes d dr gc ht (b:bs) = do
_ -> drawBoxBorder d dr gc bb offset ht xx lw mgs
drawBoxes d dr gc ht bs
-drawBoxBorder :: Display -> Drawable -> GC -> BoxBorder -> BoxOffset -> Position
- -> (Position, Position) -> Position -> BoxMargins -> IO ()
-drawBoxBorder d dr gc pos (BoxOffset alg offset) ht (x1,x2) lw (BoxMargins mt mr mb ml) = do
+drawBoxBorder :: Display
+ -> Drawable
+ -> GC
+ -> BoxBorder
+ -> BoxOffset
+ -> Position
+ -> (Position, Position)
+ -> Position
+ -> BoxMargins
+ -> IO ()
+drawBoxBorder
+ d dr gc pos (BoxOffset alg offset) ht (x1,x2) lw (BoxMargins mt mr mb ml) = do
let (p1,p2) = case alg of
L -> (0, -offset)
C -> (offset, -offset)