diff options
author | jao <jao@gnu.org> | 2022-09-20 05:41:27 +0100 |
---|---|---|
committer | jao <jao@gnu.org> | 2022-09-20 05:41:27 +0100 |
commit | 4b4c9fe0a8849fad124a2f75e815e648dafd4969 (patch) | |
tree | 69fe7d3f6a5a939c8120c0ff5cd9d71a61da648e | |
parent | c7681d79108f6e03f5adc33ebb96f14cf9b83f16 (diff) | |
download | xmobar-4b4c9fe0a8849fad124a2f75e815e648dafd4969.tar.gz xmobar-4b4c9fe0a8849fad124a2f75e815e648dafd4969.tar.bz2 |
new namespace: Xmobar.Draw
-rw-r--r-- | src/Xmobar/Draw/Boxes.hs (renamed from src/Xmobar/X11/Boxes.hs) | 2 | ||||
-rw-r--r-- | src/Xmobar/Draw/Cairo.hs (renamed from src/Xmobar/X11/CairoDraw.hs) | 13 | ||||
-rw-r--r-- | src/Xmobar/Draw/Types.hs | 52 | ||||
-rw-r--r-- | src/Xmobar/X11/Bitmap.hs | 27 | ||||
-rw-r--r-- | src/Xmobar/X11/Draw.hs | 12 | ||||
-rw-r--r-- | src/Xmobar/X11/Loop.hs | 14 | ||||
-rw-r--r-- | src/Xmobar/X11/Types.hs | 18 | ||||
-rw-r--r-- | xmobar.cabal | 5 |
8 files changed, 88 insertions, 55 deletions
diff --git a/src/Xmobar/X11/Boxes.hs b/src/Xmobar/Draw/Boxes.hs index 4ea7144..1358805 100644 --- a/src/Xmobar/X11/Boxes.hs +++ b/src/Xmobar/Draw/Boxes.hs @@ -13,7 +13,7 @@ -- ------------------------------------------------------------------------------ -module Xmobar.X11.Boxes (Line, boxLines, BoxRect, borderRect) where +module Xmobar.Draw.Boxes (Line, boxLines, BoxRect, borderRect) where import qualified Xmobar.Config.Types as T import qualified Xmobar.Run.Parsers as P diff --git a/src/Xmobar/X11/CairoDraw.hs b/src/Xmobar/Draw/Cairo.hs index dd2ea2b..8fa4c46 100644 --- a/src/Xmobar/X11/CairoDraw.hs +++ b/src/Xmobar/Draw/Cairo.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ -- | --- Module: Xmobar.X11.CairoDraw +-- Module: Xmobar.X11.Cairo -- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- @@ -15,7 +15,7 @@ -- ------------------------------------------------------------------------------ -module Xmobar.X11.CairoDraw (drawSegments) where +module Xmobar.Draw.Cairo (drawSegments) where import qualified Data.Colour.SRGB as SRGB import qualified Data.Colour.Names as CNames @@ -32,9 +32,8 @@ import qualified Xmobar.Config.Parse as ConfigParse import qualified Xmobar.Run.Parsers as P import qualified Xmobar.Text.Pango as TextPango -import qualified Xmobar.X11.Boxes as Boxes -import qualified Xmobar.X11.Bitmap as B -import qualified Xmobar.X11.Types as T +import qualified Xmobar.Draw.Boxes as Boxes +import qualified Xmobar.Draw.Types as T type Renderinfo = (P.Segment, Surface -> Double -> Double -> IO (), Double) type BoundedBox = (Double, Double, [P.Box]) @@ -96,7 +95,7 @@ withRenderinfo _ _ seg@(P.Hspace w, _, _, _) = withRenderinfo _ dctx seg@(P.Icon p, _, _, _) = do let bm = T.dcBitmapLookup dctx p - wd = maybe 0 (fromIntegral . B.width) bm + wd = maybe 0 (fromIntegral . T.bWidth) bm ioff = C.iconOffset (T.dcConfig dctx) vpos = T.dcHeight dctx / 2 + fromIntegral ioff render _ off mx = when (off + wd <= mx) $ T.dcBitmapDrawer dctx off vpos p @@ -124,7 +123,7 @@ drawSegment :: T.DrawContext -> Surface -> Double -> Acc -> Renderinfo -> IO Acc drawSegment dctx surface maxoff (off, acts, boxs) (segment, render, lwidth) = do let end = min maxoff (off + lwidth) (_, info, _, a) = segment - acts' = case a of Just as -> (as, round off, round end):acts; _ -> acts + acts' = case a of Just as -> (as, off, end):acts; _ -> acts bs = P.tBoxes info boxs' = if null bs then boxs else (off, end, bs):boxs drawSegmentBackground dctx surface info off end diff --git a/src/Xmobar/Draw/Types.hs b/src/Xmobar/Draw/Types.hs new file mode 100644 index 0000000..219a64b --- /dev/null +++ b/src/Xmobar/Draw/Types.hs @@ -0,0 +1,52 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.Draw.Types +-- Copyright: (c) 2022 jao +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: mail@jao.io +-- Stability: unstable +-- Portability: portable +-- Created: Tue Sep 20, 2022 04:49 +-- +-- +-- Type definitions for describing drawing operations +-- +------------------------------------------------------------------------------ + + +module Xmobar.Draw.Types where + +import GHC.Word (Word32, Word64) + +import Data.Map (Map) + +import Xmobar.Config.Types (Config) +import Xmobar.Run.Actions (Action) +import Xmobar.Run.Parsers (Segment) + +type Position = Double +type ActionPos = ([Action], Position, Position) +type Actions = [ActionPos] + +type BitmapDrawer = Double -> Double -> String -> IO () + +data BitmapType = Mono Word64 | Poly + +data Bitmap = Bitmap { bWidth :: Word32 + , bHeight :: Word32 + , bPixmap :: Word64 + , bShapepixmap :: Maybe Word64 + , bBitmaptype :: BitmapType + } + +type BitmapCache = Map FilePath Bitmap + + +data DrawContext = DC { dcBitmapDrawer :: BitmapDrawer + , dcBitmapLookup :: String -> Maybe Bitmap + , dcConfig :: Config + , dcWidth :: Double + , dcHeight :: Double + , dcSegments :: [[Segment]] + } diff --git a/src/Xmobar/X11/Bitmap.hs b/src/Xmobar/X11/Bitmap.hs index 220741e..d6a818b 100644 --- a/src/Xmobar/X11/Bitmap.hs +++ b/src/Xmobar/X11/Bitmap.hs @@ -20,10 +20,14 @@ module Xmobar.X11.Bitmap import Control.Monad import Control.Monad.Trans(MonadIO(..)) import Data.Map hiding (map) + import Graphics.X11.Xlib hiding (Segment) + import System.Directory (doesFileExist) import System.FilePath ((</>)) import System.Mem.Weak ( addFinalizer ) + +import Xmobar.Draw.Types (BitmapType(..), Bitmap(..), BitmapCache) import Xmobar.X11.ColorCache #ifdef XPM @@ -43,17 +47,6 @@ runExceptT = runErrorT #endif -data BitmapType = Mono Pixel | Poly - -data Bitmap = Bitmap { width :: Dimension - , height :: Dimension - , pixmap :: Pixmap - , shapePixmap :: Maybe Pixmap - , bitmapType :: BitmapType - } - -type BitmapCache = Map FilePath Bitmap - updateCache :: Display -> Window -> Map FilePath Bitmap -> FilePath -> [FilePath] -> IO BitmapCache updateCache dpy win cache iconRoot paths = do @@ -114,15 +107,15 @@ drawBitmap :: Display -> Drawable -> GC -> String -> String -> Position -> Position -> Bitmap -> IO () drawBitmap d p gc fc bc x y i = withColors d [fc, bc] $ \[fc', bc'] -> do - let w = width i - h = height i + let w = bWidth i + h = bHeight i y' = 1 + y - fromIntegral h `div` 2 setForeground d gc fc' setBackground d gc bc' - case shapePixmap i of + case bShapepixmap i of Nothing -> return () Just mask -> setClipOrigin d gc x y' >> setClipMask d gc mask - case bitmapType i of - Poly -> copyArea d (pixmap i) p gc 0 0 w h x y' - Mono pl -> copyPlane d (pixmap i) p gc 0 0 w h x y' pl + case bBitmaptype i of + Poly -> copyArea d (bPixmap i) p gc 0 0 w h x y' + Mono pl -> copyPlane d (bPixmap i) p gc 0 0 w h x y' pl setClipMask d gc 0 diff --git a/src/Xmobar/X11/Draw.hs b/src/Xmobar/X11/Draw.hs index 48ddb91..7e0dfd1 100644 --- a/src/Xmobar/X11/Draw.hs +++ b/src/Xmobar/X11/Draw.hs @@ -26,16 +26,18 @@ import qualified Graphics.X11.Xlib as X11 import qualified Xmobar.Config.Types as C import qualified Xmobar.Run.Parsers as P +import qualified Xmobar.Draw.Types as D +import qualified Xmobar.Draw.Cairo as DC + import qualified Xmobar.X11.Bitmap as B import qualified Xmobar.X11.Types as T -import qualified Xmobar.X11.CairoDraw as CD import qualified Xmobar.X11.CairoSurface as CS #ifdef XRENDER import qualified Xmobar.X11.XRender as XRender #endif -drawXBitmap :: T.XConf -> X11.GC -> X11.Pixmap -> T.BitmapDrawer +drawXBitmap :: T.XConf -> X11.GC -> X11.Pixmap -> D.BitmapDrawer drawXBitmap xconf gc p h v path = do let disp = T.display xconf conf = T.config xconf @@ -64,7 +66,7 @@ withPixmap disp win (X11.Rectangle _ _ w h) depth action = do X11.sync disp True return res -draw :: [[P.Segment]] -> T.X [T.ActionPos] +draw :: [[P.Segment]] -> T.X [D.ActionPos] draw segments = do xconf <- ask let disp = T.display xconf @@ -78,8 +80,8 @@ draw segments = do liftIO $ withPixmap disp win rect depth $ \gc p -> do let bdraw = drawXBitmap xconf gc p blook = lookupXBitmap xconf - dctx = T.DC bdraw blook conf (fromIntegral w) (fromIntegral h) segments - render = CD.drawSegments dctx + dctx = D.DC bdraw blook conf (fromIntegral w) (fromIntegral h) segments + render = DC.drawSegments dctx #ifdef XRENDER color = C.bgColor conf diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs index 3975e21..599e680 100644 --- a/src/Xmobar/X11/Loop.hs +++ b/src/Xmobar/X11/Loop.hs @@ -43,6 +43,8 @@ import qualified Xmobar.Run.Parsers as P import qualified Xmobar.System.Utils as U import qualified Xmobar.System.Signal as S +import qualified Xmobar.Draw.Types as D + import qualified Xmobar.X11.Types as T import qualified Xmobar.X11.Text as Text import qualified Xmobar.X11.Draw as Draw @@ -100,11 +102,8 @@ eventLoop dpy w signalv = -- The list of actions provides the positions of clickable rectangles, -- and there is a mutable variable for received signals and the list -- of strings updated by running monitors. -signalLoop :: T.XConf - -> [([A.Action], X11.Position, X11.Position)] - -> STM.TMVar S.SignalType - -> STM.TVar [String] - -> IO () +signalLoop :: + T.XConf -> D.Actions -> STM.TMVar S.SignalType -> STM.TVar [String] -> IO () signalLoop xc@(T.XConf d r w fs is cfg) actions signalv strs = do typ <- STM.atomically $ STM.takeTMVar signalv case typ of @@ -168,9 +167,10 @@ updateConfigPosition disp cfg = else (cfg {C.position = C.OnScreen (n+1) o})) o -> return (cfg {C.position = C.OnScreen 1 o}) -runActions :: [T.ActionPos] -> A.Button -> X11.Position -> IO () +runActions :: D.Actions -> A.Button -> X11.Position -> IO () runActions actions button pos = mapM_ A.runAction $ filter (\(A.Spawn b _) -> button `elem` b) $ concatMap (\(a,_,_) -> a) $ - filter (\(_, from, to) -> pos >= from && pos <= to) actions + filter (\(_, from, to) -> pos' >= from && pos' <= to) actions + where pos' = fromIntegral pos diff --git a/src/Xmobar/X11/Types.hs b/src/Xmobar/X11/Types.hs index 309b6bf..e880cc0 100644 --- a/src/Xmobar/X11/Types.hs +++ b/src/Xmobar/X11/Types.hs @@ -23,9 +23,8 @@ import qualified Data.List.NonEmpty as NE import Control.Monad.Reader (ReaderT) import Xmobar.Config.Types -import Xmobar.Run.Actions (Action) -import Xmobar.Run.Parsers (Segment) -import Xmobar.X11.Bitmap (Bitmap, BitmapCache) + +import Xmobar.X11.Bitmap (BitmapCache) import Xmobar.X11.Text (XFont) -- | The X type is a ReaderT @@ -40,16 +39,3 @@ data XConf = , iconCache :: BitmapCache , config :: Config } - -type ActionPos = ([Action], X11.Position, X11.Position) -type Actions = [ActionPos] - -type BitmapDrawer = Double -> Double -> String -> IO () - -data DrawContext = DC { dcBitmapDrawer :: BitmapDrawer - , dcBitmapLookup :: String -> Maybe Bitmap - , dcConfig :: Config - , dcWidth :: Double - , dcHeight :: Double - , dcSegments :: [[Segment]] - } diff --git a/xmobar.cabal b/xmobar.cabal index 4cb0dd0..8b331f5 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -117,6 +117,9 @@ library Xmobar.Run.Actions, Xmobar.Run.Parsers, Xmobar.Run.Loop, + Xmobar.Draw.Boxes, + Xmobar.Draw.Cairo, + Xmobar.Draw.Types, Xmobar.App.Config, Xmobar.App.Main, Xmobar.App.Opts, @@ -134,8 +137,6 @@ library Xmobar.Text.SwaybarClicks, Xmobar.Text.Output, Xmobar.X11.Bitmap, - Xmobar.X11.Boxes, - Xmobar.X11.CairoDraw, Xmobar.X11.CairoSurface, Xmobar.X11.ColorCache, Xmobar.X11.Draw, |