diff options
Diffstat (limited to 'src/Xmobar/X11')
-rw-r--r-- | src/Xmobar/X11/Loop.hs | 15 | ||||
-rw-r--r-- | src/Xmobar/X11/Types.hs | 1 | ||||
-rw-r--r-- | src/Xmobar/X11/XlibDraw.hs | 90 |
3 files changed, 43 insertions, 63 deletions
diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs index e6feda0..ea1c309 100644 --- a/src/Xmobar/X11/Loop.hs +++ b/src/Xmobar/X11/Loop.hs @@ -38,8 +38,6 @@ import Xmobar.Config.Types ( persistent , alpha , font , additionalFonts - , textOffset - , textOffsets , position , iconRoot , Config @@ -74,17 +72,14 @@ x11Loop conf = do d <- openDisplay "" fs <- initFont d (font conf) fl <- mapM (initFont d) (additionalFonts conf) - let ic = Map.empty - to = textOffset conf - ts = textOffsets conf ++ replicate (length fl) to #ifdef CAIRO xftInitFtLibrary #endif (r,w) <- createWin d fs conf - loop conf (startLoop (XConf d r w (fs :| fl) (to :| ts) ic conf)) + loop conf (startLoop (XConf d r w (fs :| fl) Map.empty conf)) startLoop :: XConf -> TMVar SignalType -> TVar [String] -> IO () -startLoop xcfg@(XConf _ _ w _ _ _ _) sig tv = do +startLoop xcfg@(XConf _ _ w _ _ _) sig tv = do forkThread "X event handler" (x11EventLoop w sig) signalLoop xcfg [] sig tv @@ -120,7 +115,7 @@ signalLoop :: XConf -> TMVar SignalType -> TVar [String] -> IO () -signalLoop xc@(XConf d r w fs vos is cfg) actions signal strs = do +signalLoop xc@(XConf d r w fs is cfg) actions signal strs = do typ <- atomically $ takeTMVar signal case typ of Wakeup -> wakeup @@ -158,7 +153,7 @@ signalLoop xc@(XConf d r w fs vos is cfg) actions signal strs = do reposWindow rcfg = do r' <- repositionWin d w (NE.head fs) rcfg - signalLoop (XConf d r' w fs vos is rcfg) actions signal strs + signalLoop (XConf d r' w fs is rcfg) actions signal strs parseSegments :: Config -> TVar [String] -> IO [[Segment]] parseSegments conf v = do @@ -167,7 +162,7 @@ parseSegments conf v = do liftIO $ mapM (parseString conf) [l, c, r] updateIconCache :: XConf -> [[Segment]] -> IO XConf -updateIconCache xc@(XConf d _ w _ _ c cfg) segs = do +updateIconCache xc@(XConf d _ w _ c cfg) segs = do c' <- updateCache d w c (iconRoot cfg) [p | (Icon p, _, _, _) <- concat segs] return $ xc {iconCache = c'} diff --git a/src/Xmobar/X11/Types.hs b/src/Xmobar/X11/Types.hs index 69bb8ba..ce5eec9 100644 --- a/src/Xmobar/X11/Types.hs +++ b/src/Xmobar/X11/Types.hs @@ -35,7 +35,6 @@ data XConf = , rect :: Rectangle , window :: Window , fontList :: NE.NonEmpty XFont - , verticalOffsets :: NE.NonEmpty Int , iconCache :: BitmapCache , config :: Config } diff --git a/src/Xmobar/X11/XlibDraw.hs b/src/Xmobar/X11/XlibDraw.hs index d1432f8..f6637c5 100644 --- a/src/Xmobar/X11/XlibDraw.hs +++ b/src/Xmobar/X11/XlibDraw.hs @@ -17,7 +17,6 @@ -- ------------------------------------------------------------------------------ - module Xmobar.X11.XlibDraw (drawInPixmap, updateActions) where import Prelude hiding (lookup) @@ -49,7 +48,6 @@ drawInPixmap gc p wid ht ~[left,center,right] = do let c = config r d = display r fs = fontList r - vs = verticalOffsets r strLn = liftIO . mapM getWidth iconW i = maybe 0 B.width (lookup i $ iconCache r) getWidth (Text s,cl,i,_) = @@ -62,9 +60,9 @@ drawInPixmap gc p wid ht ~[left,center,right] = do liftIO $ fillRectangle d p gc 0 0 wid ht -- write to the pixmap the new string - printStrings p gc fs vs 1 L [] =<< strLn left - printStrings p gc fs vs 1 R [] =<< strLn right - printStrings p gc fs vs 1 C [] =<< strLn center + printStrings p gc fs 1 L [] =<< strLn left + printStrings p gc fs 1 R [] =<< strLn right + printStrings p gc fs 1 C [] =<< strLn center -- draw border if requested liftIO $ drawBorder (border c) (borderWidth c) d p gc bdcolor wid ht @@ -93,17 +91,14 @@ printString d p fs gc fc bc x y _ _ s a = when (a == 255) (setBackground d gc bc') liftIO $ wcDrawImageString d p fs gc x y s --- | An easy way to print the stuff we need to print -printStrings :: Drawable - -> GC +printStrings :: Drawable -> GC -> NE.NonEmpty XFont - -> NE.NonEmpty Int - -> Position - -> Align + -> Position -> Align -> [((Position, Position), Box)] - -> [(Widget, TextRenderInfo, Int, Position)] -> X () -printStrings _ _ _ _ _ _ _ [] = return () -printStrings dr gc fontlist voffs offs a boxes sl@((s,c,i,l):xs) = do + -> [(Widget, TextRenderInfo, Int, Position)] + -> X () +printStrings _ _ _ _ _ _ [] = return () +printStrings dr gc fontlist offs a boxes sl@((s,c,i,l):xs) = do r <- ask let conf = config r d = display r @@ -112,7 +107,7 @@ printStrings dr gc fontlist voffs offs a boxes sl@((s,c,i,l):xs) = do totSLen = foldr (\(_,_,_,len) -> (+) len) 0 sl remWidth = fi wid - fi totSLen fontst = safeIndex fontlist i - voff = safeIndex voffs i + voff = indexedOffset conf i offset = case a of C -> (remWidth + offs) `div` 2 R -> remWidth @@ -137,35 +132,7 @@ printStrings dr gc fontlist voffs offs a boxes sl@((s,c,i,l):xs) = do if Prelude.null xs then liftIO $ drawBoxes d dr gc (fromIntegral ht) (dropBoxes ++ boxes') else liftIO $ drawBoxes d dr gc (fromIntegral ht) dropBoxes - printStrings dr gc fontlist voffs (offs + l) a boxes' xs - -drawBoxes :: Display - -> Drawable - -> GC - -> Position - -> [((Position, Position), Box)] - -> IO () -drawBoxes _ _ _ _ [] = return () -drawBoxes d dr gc ht (b:bs) = do - let (xx, Box bb offset lineWidth fc mgs) = b - lw = fromIntegral lineWidth :: Position - withColors d [fc] $ \[fc'] -> do - setForeground d gc fc' - setLineAttributes d gc lineWidth lineSolid capNotLast joinMiter - case bb of - BBVBoth -> do - drawBoxBorder d dr gc BBTop offset ht xx lw mgs - drawBoxBorder d dr gc BBBottom offset ht xx lw mgs - BBHBoth -> do - drawBoxBorder d dr gc BBLeft offset ht xx lw mgs - drawBoxBorder d dr gc BBRight offset ht xx lw mgs - BBFull -> do - drawBoxBorder d dr gc BBTop offset ht xx lw mgs - drawBoxBorder d dr gc BBBottom offset ht xx lw mgs - drawBoxBorder d dr gc BBLeft offset ht xx lw mgs - drawBoxBorder d dr gc BBRight offset ht xx lw mgs - _ -> drawBoxBorder d dr gc bb offset ht xx lw mgs - drawBoxes d dr gc ht bs + printStrings dr gc fontlist (offs + l) a boxes' xs drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel -> Dimension -> Dimension -> IO () @@ -200,15 +167,34 @@ calcBorderOffset :: (Integral a) => Int -> a calcBorderOffset = ceiling . (/2) . toDouble where toDouble = fi :: (Integral a) => a -> Double +drawBoxes :: Display -> Drawable -> GC + -> Position -> [((Position, Position), Box)] + -> IO () +drawBoxes _ _ _ _ [] = return () +drawBoxes d dr gc ht (b:bs) = do + let (xx, Box bb offset lineWidth fc mgs) = b + lw = fromIntegral lineWidth :: Position + withColors d [fc] $ \[fc'] -> do + setForeground d gc fc' + setLineAttributes d gc lineWidth lineSolid capNotLast joinMiter + case bb of + BBVBoth -> do + drawBoxBorder d dr gc BBTop offset ht xx lw mgs + drawBoxBorder d dr gc BBBottom offset ht xx lw mgs + BBHBoth -> do + drawBoxBorder d dr gc BBLeft offset ht xx lw mgs + drawBoxBorder d dr gc BBRight offset ht xx lw mgs + BBFull -> do + drawBoxBorder d dr gc BBTop offset ht xx lw mgs + drawBoxBorder d dr gc BBBottom offset ht xx lw mgs + drawBoxBorder d dr gc BBLeft offset ht xx lw mgs + drawBoxBorder d dr gc BBRight offset ht xx lw mgs + _ -> drawBoxBorder d dr gc bb offset ht xx lw mgs + drawBoxes d dr gc ht bs -drawBoxBorder :: Display - -> Drawable - -> GC - -> BoxBorder - -> BoxOffset - -> Position - -> (Position, Position) - -> Position +drawBoxBorder :: Display -> Drawable -> GC + -> BoxBorder -> BoxOffset + -> Position -> (Position, Position) -> Position -> BoxMargins -> IO () drawBoxBorder |