summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar')
-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.hs52
-rw-r--r--src/Xmobar/X11/Bitmap.hs27
-rw-r--r--src/Xmobar/X11/Draw.hs12
-rw-r--r--src/Xmobar/X11/Loop.hs14
-rw-r--r--src/Xmobar/X11/Types.hs18
7 files changed, 85 insertions, 53 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]]
- }
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 20:10:41 +0000