From 65f2bb18a372fc32a95c9887ba7a4006dc4ea24a Mon Sep 17 00:00:00 2001 From: jao Date: Sun, 11 Sep 2022 00:52:29 +0100 Subject: cairo: outer border --- src/Xmobar/Run/Parsers.hs | 5 +++++ src/Xmobar/X11/CairoDraw.hs | 53 +++++++++++++++++++++++++++++++++++++-------- src/Xmobar/X11/Window.hs | 34 ----------------------------- src/Xmobar/X11/XlibDraw.hs | 43 +++++++++++++++++++++++++++++++----- 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 -- cgit v1.2.3