summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Xmobar/X11/Draw.hs40
-rw-r--r--src/Xmobar/X11/Parsers.hs57
2 files changed, 59 insertions, 38 deletions
diff --git a/src/Xmobar/X11/Draw.hs b/src/Xmobar/X11/Draw.hs
index 0e07573..22b88ae 100644
--- a/src/Xmobar/X11/Draw.hs
+++ b/src/Xmobar/X11/Draw.hs
@@ -105,14 +105,14 @@ verticalOffset ht (Icon _) _ _ conf
printString :: Display -> Drawable -> XFont -> GC -> String -> String
-> Position -> Position -> Position -> Position -> String -> Int -> IO ()
-printString d p (Core fs) gc fc bc x y ay ht s a = do
+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
setForeground d gc fc'
when (a == 255) (setBackground d gc bc')
drawImageString d p gc x y s
-printString d p (Utf8 fs) gc fc bc x y ay ht s a =
+printString d p (Utf8 fs) gc fc bc x y _ _ s a =
withColors d [fc, bc] $ \[fc', bc'] -> do
setForeground d gc fc'
when (a == 255) (setBackground d gc bc')
@@ -171,38 +171,38 @@ printStrings dr gc fontlist voffs offs a boxes sl@((s,c,i,l):xs) = do
drawBoxes :: Display -> Drawable -> GC -> Position -> [((Position, Position), Box)] -> IO ()
drawBoxes _ _ _ _ [] = return ()
drawBoxes d dr gc ht (b:bs) = do
- let (xx, Box pos alg offset lineWidth fc) = b
+ let (xx, Box bb offset lineWidth fc mgs) = b
lw = fromIntegral lineWidth :: Position
withColors d [fc] $ \[fc'] -> do
setForeground d gc fc'
setLineAttributes d gc lineWidth lineSolid capNotLast joinMiter
- case pos of
+ case bb of
BBVBoth -> do
- drawBoxBorder d dr gc BBTop alg offset ht xx lw
- drawBoxBorder d dr gc BBBottom alg offset ht xx lw
+ drawBoxBorder d dr gc BBTop offset ht xx lw mgs
+ drawBoxBorder d dr gc BBBottom offset ht xx lw mgs
BBHBoth -> do
- drawBoxBorder d dr gc BBLeft alg offset ht xx lw
- drawBoxBorder d dr gc BBRight alg offset ht xx lw
+ drawBoxBorder d dr gc BBLeft offset ht xx lw mgs
+ drawBoxBorder d dr gc BBRight offset ht xx lw mgs
BBFull -> do
- drawBoxBorder d dr gc BBTop alg offset ht xx lw
- drawBoxBorder d dr gc BBBottom alg offset ht xx lw
- drawBoxBorder d dr gc BBLeft alg offset ht xx lw
- drawBoxBorder d dr gc BBRight alg offset ht xx lw
- _ -> drawBoxBorder d dr gc pos alg offset ht xx lw
+ drawBoxBorder d dr gc BBTop offset ht xx lw mgs
+ drawBoxBorder d dr gc BBBottom offset ht xx lw mgs
+ drawBoxBorder d dr gc BBLeft offset ht xx lw mgs
+ drawBoxBorder d dr gc BBRight offset ht xx lw mgs
+ _ -> drawBoxBorder d dr gc bb offset ht xx lw mgs
drawBoxes d dr gc ht bs
-drawBoxBorder :: Display -> Drawable -> GC -> BoxBorder -> Align -> Position -> Position
- -> (Position, Position) -> Position -> IO ()
-drawBoxBorder d dr gc pos alg offset ht (x1,x2) lw = 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)
R -> (offset, 0 )
lc = lw `div` 2
case pos of
- BBTop -> drawLine d dr gc (x1 + p1) lc (x2 + p2) lc
+ BBTop -> drawLine d dr gc (x1 + p1) (mt + lc) (x2 + p2) (mt + lc)
BBBottom -> do
- let lc' = max lc 1
+ let lc' = max lc 1 + mb
drawLine d dr gc (x1 + p1) (ht - lc') (x2 + p2) (ht - lc')
- BBLeft -> drawLine d dr gc (x1 - 1) p1 (x1 - 1) (ht + p2)
- BBRight -> drawLine d dr gc (x2 + lc - 1) p1 (x2 + lc - 1) (ht + p2)
+ BBLeft -> drawLine d dr gc (x1 - 1 + ml) p1 (x1 - 1 + ml) (ht + p2)
+ BBRight -> drawLine d dr gc (x2 + lc - 1 - mr) p1 (x2 + lc - 1 - mr) (ht + p2)
diff --git a/src/Xmobar/X11/Parsers.hs b/src/Xmobar/X11/Parsers.hs
index 7fa5c00..d35cfa0 100644
--- a/src/Xmobar/X11/Parsers.hs
+++ b/src/Xmobar/X11/Parsers.hs
@@ -14,7 +14,8 @@
--
-----------------------------------------------------------------------------
-module Xmobar.X11.Parsers (parseString, Box(..), BoxBorder(..), TextRenderInfo(..), Widget(..)) where
+module Xmobar.X11.Parsers (parseString, Box(..), BoxBorder(..), BoxOffset(..),
+ BoxMargins(..), TextRenderInfo(..), Widget(..)) where
import Xmobar.Config.Types
import Xmobar.X11.Actions
@@ -29,6 +30,9 @@ import Foreign.C.Types (CInt)
data Widget = Icon String | Text String
+data BoxOffset = BoxOffset Align Int32 deriving Eq
+-- margins: Top, Right, Bottom, Left
+data BoxMargins = BoxMargins Int32 Int32 Int32 Int32 deriving Eq
data BoxBorder = BBTop
| BBBottom
| BBVBoth
@@ -37,19 +41,7 @@ data BoxBorder = BBTop
| BBHBoth
| BBFull
deriving ( Read, Eq )
-data Box = Box BoxBorder Align Int32 CInt String deriving ( Eq )
-instance Read Box where
- readsPrec _ input = do
- let b = case words input of
- [pos] -> Just $ Box (read pos) C 0 1 "white"
- [pos,alg] -> Just $ Box (read pos) (read alg) 0 1 "white"
- [pos,alg,off] -> Just $ Box (read pos) (read alg) (read off) 1 "white"
- [pos,alg,off,wdh] -> Just $ Box (read pos) (read alg) (read off) (read wdh) "white"
- [pos,alg,off,wdh,c] -> Just $ Box (read pos) (read alg) (read off) (read wdh) c
- _ -> Nothing
- case b of
- Just b' -> [(b', "")]
- _ -> []
+data Box = Box BoxBorder BoxOffset CInt String BoxMargins deriving Eq
data TextRenderInfo =
TextRenderInfo { tColorsString :: String
, tBgTopOffset :: Int32
@@ -94,7 +86,7 @@ textParser c f a = do s <- many1 $
noneOf "<" <|>
try (notFollowedBy' (char '<')
(try (string "fc=") <|>
- try (string "box=") <|>
+ try (string "box") <|>
try (string "fn=") <|>
try (string "action=") <|>
try (string "/action>") <|>
@@ -177,13 +169,42 @@ colorParser (TextRenderInfo _ _ _ bs) f a = do
boxParser :: TextRenderInfo -> FontIndex -> Maybe [Action]
-> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])]
boxParser (TextRenderInfo cs ot ob bs) f a = do
- c <- between (string "<box=") (string ">") (many1 (alphaNum <|> char ' ' <|> char '#'))
- let b = fromMaybe (Box BBFull C 0 1 "white") $ readMaybe c
+ c <- between (string "<box") (string ">") (option "" (many1 (alphaNum <|> char '=' <|> char ' ' <|> char '#' <|> char ',')))
+ let b = Box BBFull (BoxOffset C 0) 1 cs (BoxMargins 0 0 0 0)
+ let g = boxReader b (words c)
s <- manyTill
- (allParsers (TextRenderInfo cs ot ob (b : bs)) f a)
+ (allParsers (TextRenderInfo cs ot ob (g : bs)) f a)
(try $ string "</box>")
return (concat s)
+
+boxReader :: Box -> [String] -> Box
+boxReader b [] = b
+boxReader b (x:xs) = do
+ let (param,val) = case break (=='=') x of
+ (p,'=':v) -> (p, v)
+ (p, _) -> (p, "")
+ boxReader (boxParamReader b param val) xs
+boxParamReader :: Box -> String -> String -> Box
+boxParamReader b _ "" = b
+boxParamReader (Box bb off lw fc mgs) "type" val =
+ Box (fromMaybe bb $ readMaybe ("BB" ++ val)) off lw fc mgs
+boxParamReader (Box bb (BoxOffset alg off) lw fc mgs) "offset" (a:o) =
+ Box bb (BoxOffset (fromMaybe alg $ readMaybe [a]) (fromMaybe off $ readMaybe o)) lw fc mgs
+boxParamReader (Box bb off lw fc mgs) "width" val =
+ Box bb off (fromMaybe lw $ readMaybe val) fc mgs
+boxParamReader (Box bb off lw _ mgs) "color" val =
+ Box bb off lw val mgs
+boxParamReader (Box bb off lw fc mgs@(BoxMargins mt mr mb ml)) ('m':pos) val = do
+ let mgs' = case pos of
+ "t" -> BoxMargins (fromMaybe mt $ readMaybe val) mr mb ml
+ "r" -> BoxMargins mt (fromMaybe mr $ readMaybe val) mb ml
+ "b" -> BoxMargins mt mr (fromMaybe mb $ readMaybe val) ml
+ "l" -> BoxMargins mt mr mb (fromMaybe ml $ readMaybe val)
+ _ -> mgs
+ Box bb off lw fc mgs'
+boxParamReader b _ _ = b
+
-- | Parsers a string wrapped in a font specification.
fontParser :: TextRenderInfo -> Maybe [Action]
-> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])]
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-03 06:01:44 +0000