diff options
| -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, | 
