From d5f183887ad9b852740ef533b5f9fe8cb30e73ca Mon Sep 17 00:00:00 2001
From: Jens Nolte <jens@nightmarestudio.de>
Date: Mon, 10 Feb 2020 00:41:55 +0100
Subject: [PATCH] Fix render indicator by moving it to the end of the pipeline
---
src/QBar/Server.hs | 30 ++++++++++++++++--------------
src/QBar/Theme.hs | 15 +++++++++++++--
2 files changed, 29 insertions(+), 16 deletions(-)
diff --git a/src/QBar/Server.hs b/src/QBar/Server.hs
index e72cdfb..5d016ce 100644
--- a/src/QBar/Server.hs
+++ b/src/QBar/Server.hs
@@ -12,7 +12,7 @@ import QBar.Pango
import QBar.Theme
import QBar.Util
-import Control.Monad (forever, when, unless, forM_)
+import Control.Monad (when, unless, forM_)
import Control.Concurrent.Async (async, link)
import Control.Concurrent.Event as Event
import Control.Concurrent.MVar (MVar, newMVar, modifyMVar, modifyMVar_)
@@ -29,9 +29,8 @@ import Pipes.Concurrent (Input, spawn, latest, toOutput, fromInput)
import qualified Pipes.Prelude as PP
import System.IO (stdin, stdout, stderr, hFlush)
-renderIndicator :: CachedBlock
--- Using 'cachedBlock' is a hack to actually get the block to update on every bar update (by doing this it will not get a cache later in the pipeline).
-renderIndicator = forever $ each $ map (mkBlockState . mkBlockOutput . normalText) ["/", "-", "\\", "|"]
+renderIndicators :: [Text]
+renderIndicators = ["*"] <> cycle ["/", "-", "\\", "|"]
data PangoBlock = PangoBlock {
pangoBlockFullText :: PangoText,
@@ -75,18 +74,27 @@ swayBarInput MainOptions{verbose} = swayBarInput'
swayBarOutput :: MainOptions -> Consumer [ThemedBlockOutput] IO ()
-swayBarOutput options = do
+swayBarOutput options@MainOptions{indicator} = do
-- Print header
liftIO $ do
putStrLn "{\"version\":1,\"click_events\":true}"
putStrLn "["
- swayBarOutput'
+ if indicator
+ then swayBarOutputWithIndicator' renderIndicators
+ else swayBarOutput'
where
swayBarOutput' :: Consumer [ThemedBlockOutput] IO ()
swayBarOutput' = do
- await >>= (liftIO . outputLine options)
+ blockOutputs <- await
+ liftIO $ outputLine options blockOutputs
swayBarOutput'
+ swayBarOutputWithIndicator' :: [Text] -> Consumer [ThemedBlockOutput] IO ()
+ swayBarOutputWithIndicator' [] = throw $ userError "List should be infinite"
+ swayBarOutputWithIndicator' (ind : inds) = do
+ blockOutputs <- await
+ liftIO $ outputLine options (blockOutputs <> [whiteThemedBlockOutput ind])
+ swayBarOutputWithIndicator' inds
outputLine :: MainOptions -> [ThemedBlockOutput] -> IO ()
outputLine MainOptions{verbose} themedBlocks = do
let encodedOutput = encodeOutput themedBlocks
@@ -110,14 +118,8 @@ swayBarOutput options = do
}
runBarServer :: BarIO () -> MainOptions -> IO ()
-runBarServer defaultBarConfig options = runBarHost barServer (swayBarInput options) loadBlocks
+runBarServer defaultBarConfig options = runBarHost barServer (swayBarInput options) defaultBarConfig
where
- loadBlocks :: BarIO ()
- loadBlocks = do
- -- Load blocks
- when (indicator options) $ addBlock renderIndicator
- defaultBarConfig
-
barServer :: Consumer [BlockOutput] IO ()
barServer = do
-- Event to render the bar (fired when block output or theme is changed)
diff --git a/src/QBar/Theme.hs b/src/QBar/Theme.hs
index ca3a888..36b9867 100644
--- a/src/QBar/Theme.hs
+++ b/src/QBar/Theme.hs
@@ -69,7 +69,6 @@ findTheme themeName = maybe invalidThemeName Right $ HM.lookup themeName themes
where
invalidThemeName = Left $ "Invalid theme: " <> themeName
-
mkTheme :: SimplifiedTheme -> Theme
mkTheme theming' = StaticTheme $ map themeBlock
where
@@ -89,9 +88,22 @@ mkTheme theming' = StaticTheme $ map themeBlock
themeSegment :: SimplifiedTheme -> BlockTextSegment -> ThemedBlockTextSegment
themeSegment theming BlockTextSegment {active, importance, segmentText} = mkThemedSegment (theming active importance) segmentText
+mkThemedBlockOutput :: (Color, Maybe Color) -> Text -> ThemedBlockOutput
+mkThemedBlockOutput color text = ThemedBlockOutput {
+ _fullText = mkThemedText color text,
+ _shortText = Nothing,
+ _blockName = Nothing
+}
+
+mkThemedText :: (Color, Maybe Color) -> Text -> ThemedBlockText
+mkThemedText color text = ThemedBlockText [mkThemedSegment color text]
+
mkThemedSegment :: (Color, Maybe Color) -> Text -> ThemedBlockTextSegment
mkThemedSegment (color, backgroundColor) text = ThemedBlockTextSegment{themedSegmentText=text, color, backgroundColor}
+whiteThemedBlockOutput :: Text -> ThemedBlockOutput
+whiteThemedBlockOutput = mkThemedBlockOutput (ColorRGB (RGB 1 1 1), Nothing)
+
invalidColor :: Color
invalidColor = ColorRGBA (RGB (0x96 / 255) (0x98 / 255) (0x96 / 255)) (0x77 / 255)
@@ -151,4 +163,3 @@ rainbowTheme = AnimatedTheme rainbowThemePipe
let hue' = position * 3
color = hsv hue' 0.8 1.0
in ColorRGB color
-
--
GitLab