From f2605d44a6c758045aba4397f367ffbb9ea24105 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Mon, 6 May 2024 21:37:24 +0200
Subject: feat: load colors from X resources

---
 app/Main.hs | 62 ++++++++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 45 insertions(+), 17 deletions(-)

(limited to 'app/Main.hs')

diff --git a/app/Main.hs b/app/Main.hs
index 30a40df..93db14c 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -15,6 +15,7 @@ import Control.Monad.Identity
 import Data.Bits
 import Data.List
 import Data.Map qualified as M
+import Data.Maybe
 import GHC.Ptr (Ptr)
 import Graphics.X11 qualified as X
 import Graphics.X11.Xft qualified as X
@@ -50,7 +51,8 @@ data Env = Env
     fnt :: X.XftFont,
     drw :: X.XftDraw,
     cmap :: X.Colormap,
-    vis :: X.Visual
+    vis :: X.Visual,
+    xcolors :: M.Map P.XColor String
   }
 
 type Colors = M.Map (P.Intensity, P.Color) X.XftColor
@@ -199,6 +201,32 @@ createWindow args = do
           [lit (if args.icons then "\xf240  " else "bat "), sens bat],
           [lit " ", sens date, lit ", ", sens time]
         ]
+  xcolors <- do
+    X.rmInitialize
+    rdb <- X.rmGetStringDatabase (X.resourceManagerString dpy)
+    M.fromList
+      <$> mapM
+        ( \(n, def) -> do
+            (toEnum n,) . fromMaybe def
+              <$> X.rmGetResource rdb ("astatusbar*color" ++ show n)
+        )
+        [ (0 {- black -}, "rgb:0/0/0"),
+          (1 {- red3 -}, "rgb:205/0/0"),
+          (2 {- green3 -}, "rgb:0/205/0"),
+          (3 {- yellow3 -}, "rgb:205/205/0"),
+          (4 {- blue2 -}, "rgb:0/0/238"),
+          (5 {- meganta3 -}, "rgb:205/0/205"),
+          (6 {- cyan3 -}, "rgb:0/205/205"),
+          (7 {- gray90 -}, "rgb:229/229/229"),
+          (8 {- gray50 -}, "rgb:127/127/127"),
+          (9 {- red -}, "rgb:255/0/0"),
+          (10 {- green -}, "rgb:0/255/0"),
+          (11 {- yellow -}, "rgb:255/255/0"),
+          (12, "rgb:5c/5c/ff"),
+          (13 {- meganta -}, "rgb:255/0/255"),
+          (14 {- cyan -}, "rgb:0/255/255"),
+          (15 {- white -}, "rgb:255/255/255")
+        ]
   let env = Env {..}
   stateT <- newTVarIO State {..}
   void $ forkIO $ X.allocaXEvent $ \ev -> forever do
@@ -207,22 +235,22 @@ createWindow args = do
 
 withColors :: Env -> (Colors -> IO a) -> IO a
 withColors Env {..} act = do
-  X.withXftColorName dpy vis cmap (P.toRgb (P.Vivid, P.Black)) $ \black -> do
-    X.withXftColorName dpy vis cmap (P.toRgb (P.Vivid, P.Red)) $ \red -> do
-      X.withXftColorName dpy vis cmap (P.toRgb (P.Vivid, P.Green)) $ \green -> do
-        X.withXftColorName dpy vis cmap (P.toRgb (P.Vivid, P.Yellow)) $ \yellow -> do
-          X.withXftColorName dpy vis cmap (P.toRgb (P.Vivid, P.Blue)) $ \blue -> do
-            X.withXftColorName dpy vis cmap (P.toRgb (P.Vivid, P.Magenta)) $ \magenta -> do
-              X.withXftColorName dpy vis cmap (P.toRgb (P.Vivid, P.Cyan)) $ \cyan -> do
-                X.withXftColorName dpy vis cmap (P.toRgb (P.Vivid, P.White)) $ \white -> do
-                  X.withXftColorName dpy vis cmap (P.toRgb (P.Dull, P.Black)) $ \dullBlack -> do
-                    X.withXftColorName dpy vis cmap (P.toRgb (P.Dull, P.Red)) $ \dullRred -> do
-                      X.withXftColorName dpy vis cmap (P.toRgb (P.Dull, P.Green)) $ \dullGreen -> do
-                        X.withXftColorName dpy vis cmap (P.toRgb (P.Dull, P.Yellow)) $ \dullYellow -> do
-                          X.withXftColorName dpy vis cmap (P.toRgb (P.Dull, P.Blue)) $ \dullBlue -> do
-                            X.withXftColorName dpy vis cmap (P.toRgb (P.Dull, P.Magenta)) $ \dullMagenta -> do
-                              X.withXftColorName dpy vis cmap (P.toRgb (P.Dull, P.Cyan)) $ \dullCyan -> do
-                                X.withXftColorName dpy vis cmap (P.toRgb (P.Dull, P.White)) $ \dullWhite -> do
+  X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Vivid, P.Black)) $ \black -> do
+    X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Vivid, P.Red)) $ \red -> do
+      X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Vivid, P.Green)) $ \green -> do
+        X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Vivid, P.Yellow)) $ \yellow -> do
+          X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Vivid, P.Blue)) $ \blue -> do
+            X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Vivid, P.Magenta)) $ \magenta -> do
+              X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Vivid, P.Cyan)) $ \cyan -> do
+                X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Vivid, P.White)) $ \white -> do
+                  X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Dull, P.Black)) $ \dullBlack -> do
+                    X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Dull, P.Red)) $ \dullRred -> do
+                      X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Dull, P.Green)) $ \dullGreen -> do
+                        X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Dull, P.Yellow)) $ \dullYellow -> do
+                          X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Dull, P.Blue)) $ \dullBlue -> do
+                            X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Dull, P.Magenta)) $ \dullMagenta -> do
+                              X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Dull, P.Cyan)) $ \dullCyan -> do
+                                X.withXftColorName dpy vis cmap (xcolors M.! P.toXColor (P.Dull, P.White)) $ \dullWhite -> do
                                   let colors =
                                         M.fromList
                                           [ ((P.Vivid, P.Black), black),
-- 
cgit v1.2.3