summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Xmobar/Run/Parsers.hs5
-rw-r--r--src/Xmobar/X11/CairoDraw.hs53
-rw-r--r--src/Xmobar/X11/Window.hs34
-rw-r--r--src/Xmobar/X11/XlibDraw.hs43
4 files changed, 86 insertions, 49 deletions
diff --git a/src/Xmobar/Run/Parsers.hs b/src/Xmobar/Run/Parsers.hs
index 7c5e64c..8da7204 100644
--- a/src/Xmobar/Run/Parsers.hs
+++ b/src/Xmobar/Run/Parsers.hs
@@ -38,8 +38,10 @@ import Xmobar.Run.Actions
data Widget = Icon String | Text String | Hspace Int32 deriving Show
data BoxOffset = BoxOffset Align Int32 deriving (Eq, Show)
+
-- margins: Top, Right, Bottom, Left
data BoxMargins = BoxMargins Int32 Int32 Int32 Int32 deriving (Eq, Show)
+
data BoxBorder = BBTop
| BBBottom
| BBVBoth
@@ -48,13 +50,16 @@ data BoxBorder = BBTop
| BBHBoth
| BBFull
deriving ( Read, Eq, Show )
+
data Box = Box BoxBorder BoxOffset CInt String BoxMargins deriving (Eq, Show)
+
data TextRenderInfo =
TextRenderInfo { tColorsString :: String
, tBgTopOffset :: Int32
, tBgBottomOffset :: Int32
, tBoxes :: [Box]
} deriving Show
+
type FontIndex = Int
type Segment = (Widget, TextRenderInfo, FontIndex, Maybe [Action])
diff --git a/src/Xmobar/X11/CairoDraw.hs b/src/Xmobar/X11/CairoDraw.hs
index 8adedda..464dfa3 100644
--- a/src/Xmobar/X11/CairoDraw.hs
+++ b/src/Xmobar/X11/CairoDraw.hs
@@ -37,6 +37,7 @@ import Xmobar.X11.CairoSurface
type ActionPos = ([Action], Position, Position)
type Actions = [ActionPos]
+type LayoutInfo = (Segment, P.PangoLayout, Double, Double)
drawInPixmap :: Pixmap -> Dimension -> Dimension -> [[Segment]] -> X Actions
drawInPixmap p w h s = do
@@ -56,8 +57,6 @@ segmentMarkup conf (Text txt, info, idx, _actions) =
in P.markSpan attrs $ P.escapeMarkup txt
segmentMarkup _ _ = ""
-type LayoutInfo = (Segment, P.PangoLayout, Double, Double)
-
withLayoutInfo :: P.PangoContext -> Double -> Config -> Segment -> IO LayoutInfo
withLayoutInfo ctx maxh conf seg@(Text _, inf, idx, a) = do
lyt <- P.layoutEmpty ctx
@@ -74,9 +73,9 @@ withLayoutInfo ctx _ _ seg = do
renderLayout :: Surface -> Double -> (Double, Actions)
-> LayoutInfo -> IO (Double, Actions)
-renderLayout surface maxoff (off, actions) (segment, lyt, lwidth, voff) = do
+renderLayout surface maxoff (off, actions) (segment, lyt, lwidth, voff) =
if off + lwidth > maxoff
- then return (off, actions)
+ then pure (off, actions)
else do
C.renderWith surface $ C.moveTo off voff >> P.showLayout lyt
let end = round $ off + lwidth
@@ -84,18 +83,52 @@ renderLayout surface maxoff (off, actions) (segment, lyt, lwidth, voff) = do
actions' = case a of Just as -> (as, round off, end):actions; _ -> actions
return (off + lwidth, actions')
+setSourceColor :: RGBS.Colour Double -> C.Render ()
+setSourceColor = RGBS.uncurryRGB C.setSourceRGB . SRGB.toSRGB
+
background :: Config -> SRGB.Colour Double -> C.Render ()
background conf colour = do
- RGBS.uncurryRGB C.setSourceRGB (SRGB.toSRGB colour)
+ setSourceColor colour
C.paintWithAlpha $ (fromIntegral (alpha conf)) / 255.0
+readColourName :: String -> IO (RGBS.Colour Double)
+readColourName str = do
+ case CNames.readColourName str of
+ Just c -> return c
+ Nothing -> return $ SRGB.sRGB24read str
+
renderBackground :: Config -> Surface -> IO ()
renderBackground conf surface = do
- col <- case CNames.readColourName (bgColor conf) of
- Just c -> return c
- Nothing -> return $ SRGB.sRGB24read (bgColor conf)
+ col <- readColourName (bgColor conf)
C.renderWith surface (background conf col)
+drawRect :: String -> Double -> (Double, Double, Double, Double) -> C.Render()
+drawRect name wd (x0, y0, x1, y1) = do
+ col <- liftIO $ readColourName name
+ setSourceColor col
+ C.setLineWidth wd
+ C.rectangle x0 y0 x1 y1
+ C.strokePreserve
+
+outerBorder :: Config -> Double -> Double -> C.Render ()
+outerBorder conf w h = do
+ let r = case border conf of
+ TopB -> (0, 0, w - 1, 0)
+ BottomB -> (0, h - 1, w - 1, h - 1)
+ FullB -> (0, 0, w - 1, h - 1)
+ TopBM m -> (0, fi m, w - 1, fi m)
+ BottomBM m -> (0, h - fi m, w - 1, h - fi m)
+ FullBM m -> (fi m, fi m, w - fi m - 1, h - fi m - 1)
+ NoBorder -> (-1, -1, -1, -1)
+ drawRect (borderColor conf) (fi (borderWidth conf)) r
+ where fi = fromIntegral
+
+renderBorder :: Config -> Double -> Double -> Surface -> IO ()
+renderBorder conf w h surf =
+ case border conf of
+ NoBorder -> return ()
+ _ -> C.renderWith surf (outerBorder conf w h)
+
layoutsWidth :: [(Segment, P.PangoLayout, Double, Double)] -> Double
layoutsWidth = foldl (\a (_,_,w,_) -> a + w) 0
@@ -117,4 +150,6 @@ renderSegments conf w h segments surface = do
cw = layoutsWidth clyts
cstart = lend + 1 + max 0 (dw - rw - lend - cw) / 2.0
(_, as') <- foldM (renderLayout surface cmax) (cstart, as) clyts
- snd `fmap` foldM (renderLayout surface dw) (rstart, as') rlyts
+ (_, as'') <- foldM (renderLayout surface dw) (rstart, as') rlyts
+ when (borderWidth conf > 0) (renderBorder conf dw dh surface)
+ return as''
diff --git a/src/Xmobar/X11/Window.hs b/src/Xmobar/X11/Window.hs
index 3612a19..d42d74a 100644
--- a/src/Xmobar/X11/Window.hs
+++ b/src/Xmobar/X11/Window.hs
@@ -183,26 +183,6 @@ getStaticStrutValues (Static cx cy cw ch) rwh
xe = xs + cw - 1
getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
-drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel
- -> Dimension -> Dimension -> IO ()
-drawBorder b lw d p gc c wi ht = case b of
- NoBorder -> return ()
- TopB -> drawBorder (TopBM 0) lw d p gc c wi ht
- BottomB -> drawBorder (BottomBM 0) lw d p gc c wi ht
- FullB -> drawBorder (FullBM 0) lw d p gc c wi ht
- TopBM m -> sf >> sla >>
- drawLine d p gc 0 (fi m + boff) (fi wi) (fi m + boff)
- BottomBM m -> let rw = fi ht - fi m + boff in
- sf >> sla >> drawLine d p gc 0 rw (fi wi) rw
- FullBM m -> let mp = fi m
- pad = 2 * fi mp + fi lw
- in sf >> sla >>
- drawRectangle d p gc mp mp (wi - pad) (ht - pad)
- where sf = setForeground d gc c
- sla = setLineAttributes d gc (fi lw) lineSolid capNotLast joinMiter
- boff = borderOffset b lw
--- boff' = calcBorderOffset lw :: Int
-
hideWindow :: Display -> Window -> IO ()
hideWindow d w = do
setStruts' d w (replicate 12 0)
@@ -217,17 +197,3 @@ showWindow r c d w = do
isMapped :: Display -> Window -> IO Bool
isMapped d w = ism <$> getWindowAttributes d w
where ism WindowAttributes { wa_map_state = wms } = wms /= waIsUnmapped
-
-borderOffset :: (Integral a) => Border -> Int -> a
-borderOffset b lw =
- case b of
- BottomB -> negate boffs
- BottomBM _ -> negate boffs
- TopB -> boffs
- TopBM _ -> boffs
- _ -> 0
- where boffs = calcBorderOffset lw
-
-calcBorderOffset :: (Integral a) => Int -> a
-calcBorderOffset = ceiling . (/2) . toDouble
- where toDouble = fi :: (Integral a) => a -> Double
diff --git a/src/Xmobar/X11/XlibDraw.hs b/src/Xmobar/X11/XlibDraw.hs
index c0bdb36..5525b70 100644
--- a/src/Xmobar/X11/XlibDraw.hs
+++ b/src/Xmobar/X11/XlibDraw.hs
@@ -38,7 +38,6 @@ 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
@@ -62,6 +61,7 @@ drawInPixmap gc p wid ht ~[left,center,right] = do
textWidth d (safeIndex fs i) s >>= \tw -> return (Text s,cl,i,fi tw)
getWidth (Icon s,cl,i,_) = return (Icon s,cl,i,fi $ iconW s)
getWidth (Hspace s,cl,i,_) = return (Hspace s,cl,i,fi s)
+ fillBackground clr = setForeground d gc clr >> fillRectangle d p gc 0 0 wid ht
#if XFT
when (alpha c /= 255)
@@ -70,12 +70,9 @@ drawInPixmap gc p wid ht ~[left,center,right] = do
withColors d [bgColor c, borderColor c] $ \[bgcolor, bdcolor] -> do
#if XFT
- when (alpha c == 255) $ do
- liftIO $ setForeground d gc bgcolor
- liftIO $ fillRectangle d p gc 0 0 wid ht
+ when (alpha c == 255) $ liftIO (fillBackground bgcolor)
#else
- liftIO $ setForeground d gc bgcolor
- liftIO $ fillRectangle d p gc 0 0 wid ht
+ liftIO $ fillBackground bgcolor
#endif
-- write to the pixmap the new string
printStrings p gc fs vs 1 L [] =<< strLn left
@@ -209,6 +206,40 @@ drawBoxes d dr gc ht (b:bs) = do
_ -> drawBoxBorder d dr gc bb offset ht xx lw mgs
drawBoxes d dr gc ht bs
+drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel
+ -> Dimension -> Dimension -> IO ()
+drawBorder b lw d p gc c wi ht = case b of
+ NoBorder -> return ()
+ TopB -> drawBorder (TopBM 0) lw d p gc c wi ht
+ BottomB -> drawBorder (BottomBM 0) lw d p gc c wi ht
+ FullB -> drawBorder (FullBM 0) lw d p gc c wi ht
+ TopBM m -> sf >> sla >>
+ drawLine d p gc 0 (fi m + boff) (fi wi) (fi m + boff)
+ BottomBM m -> let rw = fi ht - fi m + boff in
+ sf >> sla >> drawLine d p gc 0 rw (fi wi) rw
+ FullBM m -> let mp = fi m
+ pad = 2 * fi mp + fi lw
+ in sf >> sla >>
+ drawRectangle d p gc mp mp (wi - pad) (ht - pad)
+ where sf = setForeground d gc c
+ sla = setLineAttributes d gc (fi lw) lineSolid capNotLast joinMiter
+ boff = borderOffset b lw
+
+borderOffset :: (Integral a) => Border -> Int -> a
+borderOffset b lw =
+ case b of
+ BottomB -> negate boffs
+ BottomBM _ -> negate boffs
+ TopB -> boffs
+ TopBM _ -> boffs
+ _ -> 0
+ where boffs = calcBorderOffset lw
+
+calcBorderOffset :: (Integral a) => Int -> a
+calcBorderOffset = ceiling . (/2) . toDouble
+ where toDouble = fi :: (Integral a) => a -> Double
+
+
drawBoxBorder :: Display
-> Drawable
-> GC
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 04:00:06 +0000