new namespace: Xmobar.Draw

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]]
-                      }