summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--app/Main.hs62
-rw-r--r--app/Pretty/Color.hs72
-rw-r--r--default.nix26
3 files changed, 87 insertions, 73 deletions
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),
diff --git a/app/Pretty/Color.hs b/app/Pretty/Color.hs
index e8e48dd..7a55909 100644
--- a/app/Pretty/Color.hs
+++ b/app/Pretty/Color.hs
@@ -2,8 +2,9 @@
module Pretty.Color
( Color (..),
- toRgb,
Intensity (..),
+ toXColor,
+ XColor (..),
)
where
@@ -18,41 +19,42 @@ data Color
| White
deriving (Show, Eq, Ord)
-toRgb :: (Intensity, Color) -> String
-toRgb (Dull, Black) = base00 -- color0
-toRgb (Dull, Red) = base08 -- color1
-toRgb (Dull, Green) = base0B -- color2
-toRgb (Dull, Yellow) = base0A -- color3
-toRgb (Dull, Blue) = base0D -- color4
-toRgb (Dull, Magenta) = base0E -- color5
-toRgb (Dull, Cyan) = base0C -- color6
-toRgb (Dull, White) = base05 -- color7
-toRgb (Vivid, Black) = base03 -- color8
-toRgb (Vivid, Red) = base08 -- color9
-toRgb (Vivid, Green) = base0B -- color10
-toRgb (Vivid, Yellow) = base0A -- color11
-toRgb (Vivid, Blue) = base0D -- color12
-toRgb (Vivid, Magenta) = base0E -- color13
-toRgb (Vivid, Cyan) = base0C -- color14
-toRgb (Vivid, White) = base07 -- color15
+toXColor :: (Intensity, Color) -> XColor
+toXColor (Dull, Black) = Color0
+toXColor (Dull, Red) = Color1
+toXColor (Dull, Green) = Color2
+toXColor (Dull, Yellow) = Color3
+toXColor (Dull, Blue) = Color4
+toXColor (Dull, Magenta) = Color5
+toXColor (Dull, Cyan) = Color6
+toXColor (Dull, White) = Color7
+toXColor (Vivid, Black) = Color8
+toXColor (Vivid, Red) = Color9
+toXColor (Vivid, Green) = Color10
+toXColor (Vivid, Yellow) = Color11
+toXColor (Vivid, Blue) = Color12
+toXColor (Vivid, Magenta) = Color13
+toXColor (Vivid, Cyan) = Color14
+toXColor (Vivid, White) = Color15
data Intensity = Vivid | Dull
deriving (Show, Eq, Ord)
-base00, base01, base02, base03, base04, base05, base06, base07, base08, base09, base0A, base0B, base0C, base0D, base0E, base0F :: String
-base00 = "#263238"
-base01 = "#2E3C43"
-base02 = "#314549"
-base03 = "#546E7A"
-base04 = "#B2CCD6"
-base05 = "#EEFFFF"
-base06 = "#EEFFFF"
-base07 = "#FFFFFF"
-base08 = "#F07178"
-base09 = "#F78C6C"
-base0A = "#FFCB6B"
-base0B = "#C3E88D"
-base0C = "#89DDFF"
-base0D = "#82AAFF"
-base0E = "#C792EA"
-base0F = "#FF5370"
+data XColor
+ = Color0
+ | Color1
+ | Color2
+ | Color3
+ | Color4
+ | Color5
+ | Color6
+ | Color7
+ | Color8
+ | Color9
+ | Color10
+ | Color11
+ | Color12
+ | Color13
+ | Color14
+ | Color15
+ deriving (Eq, Ord, Enum)
diff --git a/default.nix b/default.nix
index f670ad4..dc2a890 100644
--- a/default.nix
+++ b/default.nix
@@ -31,31 +31,15 @@ let
}));
X11 = (self.callCabal2nix "X11"
(pkgs.fetchFromGitHub {
- owner = "xmonad";
+ owner = "aforemny";
repo = "X11";
- rev = "1ead9698c89e78884ac771c93822447999a1dc46";
- hash = "sha256-OAZ3gnUezsumBC8VwhcsKq+Nrq44L4xY/z6exK7InLo=";
+ rev = "70d7a6fba00d4ffe65db90cd3a2e0883ca690a88";
+ hash = "sha256-PsRtqaTyo+z8uPpsr7G3a0WF3Wh1NTWumu0rFlkLJMM=";
})
{ }).overrideAttrs (oldAttrs: {
preConfigure = oldAttrs.preConfigure or "" + ''
- ${pkgs.autoconf}/bin/autoreconf'';
- patches = oldAttrs.patches or [ ] ++ [
- (pkgs.writers.writeText "X11-safe-select.patch" ''
- diff --git a/Graphics/X11/Xlib/Event.hsc b/Graphics/X11/Xlib/Event.hsc
- index 842fc2f..869aba8 100644
- --- a/Graphics/X11/Xlib/Event.hsc
- +++ b/Graphics/X11/Xlib/Event.hsc
- @@ -419,7 +419,7 @@ newtype FdSet = FdSet (Ptr FdSet)
- foreign import ccall unsafe "HsXlib.h" fdZero :: Ptr FdSet -> IO ()
- foreign import ccall unsafe "HsXlib.h" fdSet :: CInt -> Ptr FdSet -> IO ()
-
- -foreign import ccall unsafe "HsXlib.h" select ::
- +foreign import ccall safe "HsXlib.h" select ::
- CInt -> Ptr FdSet -> Ptr FdSet -> Ptr FdSet -> Ptr TimeVal -> IO CInt
-
- -- | This function is somewhat compatible with Win32's @TimeGetTime()@
- '')
- ];
+ ${pkgs.autoconf}/bin/autoreconf
+ '';
});
};
};
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-23 03:55:02 +0000