summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/X11/Loop.hs
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-09-10 04:33:56 +0100
committerjao <jao@gnu.org>2022-09-10 04:33:56 +0100
commitb2d0d19c4b3d33ea336e78c62e7eddfa805281ac (patch)
tree2b42db25b82ffa3e23f702bb0bbb9d19673ff541 /src/Xmobar/X11/Loop.hs
parentf81a7cfef463907ba4b68cb1352a869960350685 (diff)
downloadxmobar-b2d0d19c4b3d33ea336e78c62e7eddfa805281ac.tar.gz
xmobar-b2d0d19c4b3d33ea336e78c62e7eddfa805281ac.tar.bz2
cairo: fonts, offsets, colors, actions
Diffstat (limited to 'src/Xmobar/X11/Loop.hs')
-rw-r--r--src/Xmobar/X11/Loop.hs49
1 files changed, 10 insertions, 39 deletions
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]