From b2d0d19c4b3d33ea336e78c62e7eddfa805281ac Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Sat, 10 Sep 2022 04:33:56 +0100
Subject: cairo: fonts, offsets, colors, actions

---
 src/Xmobar/X11/Loop.hs | 49 ++++++++++---------------------------------------
 1 file changed, 10 insertions(+), 39 deletions(-)

(limited to 'src/Xmobar/X11/Loop.hs')

diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs
index 2d97733..c6a4e97 100644
--- a/src/Xmobar/X11/Loop.hs
+++ b/src/Xmobar/X11/Loop.hs
@@ -24,17 +24,13 @@ import Graphics.X11.Xlib.Extras
 import Graphics.X11.Xinerama
 import Graphics.X11.Xrandr
 
-import Control.Arrow ((&&&))
 import Control.Monad.Reader
 import Control.Concurrent
 import Control.Concurrent.STM
 
 import Data.Bits
-import Data.Map hiding (foldr, map, filter)
 import qualified Data.Map as Map
 import Data.List.NonEmpty (NonEmpty(..))
-
-import Data.Maybe (fromJust, isJust)
 import qualified Data.List.NonEmpty as NE
 
 import Xmobar.System.Signal
@@ -47,7 +43,6 @@ import Xmobar.Config.Types ( persistent
                            , position
                            , iconRoot
                            , Config
-                           , Align(..)
                            , XPosition(..))
 
 import Xmobar.Run.Actions
@@ -57,7 +52,7 @@ import Xmobar.X11.Text
 import Xmobar.X11.Draw
 import Xmobar.X11.Bitmap as Bitmap
 import Xmobar.X11.Types
-import Xmobar.System.Utils (safeIndex, forkThread)
+import Xmobar.System.Utils (forkThread)
 
 import Xmobar.Run.Loop (loop)
 
@@ -69,7 +64,7 @@ import Xmobar.X11.Events(nextEvent')
 import Graphics.X11.Xft
 #endif
 
-runX :: XConf -> X () -> IO ()
+runX :: XConf -> X a -> IO a
 runX xc f = runReaderT f xc
 
 -- | Starts the main event loop and threads
@@ -126,11 +121,14 @@ signalLoop xc@(XConf d r w fs vos is cfg) as signal tv = do
       typ <- atomically $ takeTMVar signal
       case typ of
          Wakeup -> do
-            str <- updateString cfg tv
+            str <- updateSegments cfg tv
             xc' <- updateCache d w is (iconRoot cfg) str >>=
                      \c -> return xc { iconS = c }
-            as' <- updateActions xc r str
-            runX xc' $ drawInWin r str
+#ifdef CAIRO
+            as' <- runX xc' $ drawInWin r str
+#else
+            as' <- runX xc' $ drawInWin xc r str
+#endif
             signalLoop xc' as' signal tv
 
          Reposition ->
@@ -198,35 +196,8 @@ signalLoop xc@(XConf d r w fs vos is cfg) as signal tv = do
             filter (\(_, from, to) -> x >= from && x <= to) as
           loopOn
 
-updateString :: Config -> TVar [String] -> IO [[Segment]]
-updateString conf v = do
+updateSegments :: Config -> TVar [String] -> IO [[Segment]]
+updateSegments conf v = do
   s <- readTVarIO v
   let l:c:r:_ = s ++ repeat ""
   liftIO $ mapM (parseString conf) [l, c, r]
-
-updateActions :: XConf -> Rectangle -> [[Segment]]
-              -> IO [([Action], Position, Position)]
-updateActions conf (Rectangle _ _ wid _) ~[left,center,right] = do
-  let (d,fs) = (display &&& fontListS) conf
-      strLn :: [Segment] -> IO [(Maybe [Action], Position, Position)]
-      strLn  = liftIO . mapM getCoords
-      iconW i = maybe 0 Bitmap.width (lookup i $ iconS conf)
-      getCoords (Text s,_,i,a) =
-        textWidth d (safeIndex fs i) s >>= \tw -> return (a, 0, fi tw)
-      getCoords (Icon s,_,_,a) = return (a, 0, fi $ iconW s)
-      getCoords (Hspace w,_,_,a) = return (a, 0, fi w)
-      partCoord off xs = map (\(a, x, x') -> (fromJust a, x, x')) $
-                         filter (\(a, _,_) -> isJust a) $
-                         scanl (\(_,_,x') (a,_,w') -> (a, x', x' + w'))
-                               (Nothing, 0, off)
-                               xs
-      totSLen = foldr (\(_,_,len) -> (+) len) 0
-      remWidth xs = fi wid - totSLen xs
-      offs = 1
-      offset a xs = case a of
-                     C -> (remWidth xs + offs) `div` 2
-                     R -> remWidth xs
-                     L -> offs
-  fmap concat $ mapM (\(a,xs) ->
-                       (\xs' -> partCoord (offset a xs') xs') <$> strLn xs) $
-                     zip [L,C,R] [left,center,right]
-- 
cgit v1.2.3