diff options
-rw-r--r-- | app/Main.hs | 62 | ||||
-rw-r--r-- | app/Pretty/Color.hs | 72 | ||||
-rw-r--r-- | default.nix | 26 |
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 + ''; }); }; }; |