aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Internal/LayoutDraw.hs106
-rw-r--r--src/Main.hs59
2 files changed, 88 insertions, 77 deletions
diff --git a/src/Internal/LayoutDraw.hs b/src/Internal/LayoutDraw.hs
index 7c69a08..dedac0f 100644
--- a/src/Internal/LayoutDraw.hs
+++ b/src/Internal/LayoutDraw.hs
@@ -2,6 +2,8 @@
ScopedTypeVariables, BangPatterns #-}
module Internal.LayoutDraw where
+import System.IO
+
import System.Process
import Text.Printf
import Control.Arrow
@@ -21,17 +23,17 @@ import System.Directory
import Internal.Layout
import Internal.Hash
-showLayout :: X (Maybe String)
+showLayout :: X (Bool, String, Maybe String)
showLayout = do
winset <- gets windowset
let layout = S.layout . S.workspace . S.current $ winset
- xpm <- drawPng layout
- return $ Just $ printf "<icon=%s/>" xpm
+ (cached, xpm) <- drawPng layout
+ return $ (cached, description layout, Just $ printf "<icon=%s/>" xpm)
iconSize :: (Num a) => (a, a)
iconSize = (64, 32)
-drawPng :: (LayoutClass layout Window) => layout Window -> X String
+drawPng :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
drawPng l = do
dir <- getXMonadDir
let sixWindows = [1..(4 :: Window)]
@@ -45,54 +47,54 @@ drawPng l = do
let descr = description l
let pngCacheDir = dir </> "icons" </> "cache"
- liftIO $ createDirectoryIfMissing True pngCacheDir
- let testf = dir </> "text.txt"
- let filepathPng = pngCacheDir </> (quickHash descr ++ ".png")
- let filepathXpm = pngCacheDir </> (quickHash descr ++ ".xpm")
-
- let colors = [
- -- (1.0, 1.0, 1.0),
- -- (0.9, 0.9, 1.0),
- -- (0.8, 0.8, 1.0),
- -- (0.7, 0.7, 1.0),
- (0.8, 0.6, 0.6),
- (0.8, 0.5, 0.5),
- (0.8, 0.4, 0.4),
- (0.8, 0.3, 0.3),
- (0.8, 0.2, 0.2),
- (0.8, 0.1, 0.1),
- (0.8, 0.0, 0.0)
- ]
-
- exists <- liftIO $ doesFileExist filepathXpm
- when (not exists) $
- liftIO $ do
- withImageSurface FormatARGB32 64 32 $ \surface -> do
- renderWith surface $ do
- setLineCap LineCapButt
- setLineJoin LineJoinMiter
-
- forM_ (reverse $ zip (map (second extraPad) rects) colors) $
- \((wind, Rectangle x y w h), (r, g, b)) -> do
- setSourceRGBA r g b 1
-
- rectangle
- (fromIntegral $ floor (fromIntegral x / 30.0))
- (fromIntegral $ floor (fromIntegral y / 30.0))
- (fromIntegral $ floor (fromIntegral w / 30.0))
- (fromIntegral $ floor (fromIntegral h / 30.0))
-
- fill
-
- surfaceWriteToPNG surface filepathPng
-
- out <- readProcessWithExitCode
- "/usr/bin/convert"
- [filepathPng, filepathXpm]
- ""
- return ()
-
- return filepathXpm
+ liftIO $ do
+ createDirectoryIfMissing True pngCacheDir
+ let testf = dir </> "text.txt"
+ let filepathPng = pngCacheDir </> (quickHash descr ++ ".png")
+ let filepathXpm = pngCacheDir </> (quickHash descr ++ ".xpm")
+
+ let colors = [
+ -- (1.0, 1.0, 1.0),
+ -- (0.9, 0.9, 1.0),
+ -- (0.8, 0.8, 1.0),
+ -- (0.7, 0.7, 1.0),
+ (0.8, 0.6, 0.6),
+ (0.8, 0.5, 0.5),
+ (0.8, 0.4, 0.4),
+ (0.8, 0.3, 0.3),
+ (0.8, 0.2, 0.2),
+ (0.8, 0.1, 0.1),
+ (0.8, 0.0, 0.0)
+ ]
+
+ exists <- doesFileExist filepathXpm
+ when (not exists) $ do
+ withImageSurface FormatARGB32 64 32 $ \surface -> do
+ renderWith surface $ do
+ setLineCap LineCapButt
+ setLineJoin LineJoinMiter
+
+ forM_ (reverse $ zip (map (second extraPad) rects) colors) $
+ \((wind, Rectangle x y w h), (r, g, b)) -> do
+ setSourceRGBA r g b 1
+
+ rectangle
+ (fromIntegral $ floor (fromIntegral x / 30.0))
+ (fromIntegral $ floor (fromIntegral y / 30.0))
+ (fromIntegral $ floor (fromIntegral w / 30.0))
+ (fromIntegral $ floor (fromIntegral h / 30.0))
+
+ fill
+
+ surfaceWriteToPNG surface filepathPng
+
+ _ <- handle (\(e :: SomeException) -> return ()) $ void $ readProcessWithExitCode
+ "/usr/bin/convert"
+ [filepathPng, filepathXpm]
+ ""
+ return ()
+
+ return (exists, filepathXpm)
where
extraPad (Rectangle x y w h) =
Rectangle (x + 100) (y + 100) (w - 100) (h - 100)
diff --git a/src/Main.hs b/src/Main.hs
index 28d50ad..47a00e2 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,5 +1,7 @@
import XMonad
+import Control.Exception
import XMonad.Hooks.DynamicLog
+import Control.Concurrent
import XMonad.Layout.Spacing
import XMonad.Actions.WindowNavigation
import XMonad.Util.CustomKeys
@@ -12,10 +14,15 @@ import XMonad.Layout.IndependentScreens
import Text.Printf
import Data.List.Split
import XMonad.Hooks.EwmhDesktops
+import XMonad.Hooks.ManageDocks
+import XMonad.Util.Run (spawnPipe)
+import Control.Monad (when)
+import System.IO
import Internal.Keys
import Internal.LayoutDraw
import Data.List (partition, isPrefixOf)
+import Data.Maybe
main = do
@@ -23,8 +30,10 @@ main = do
homeDir <- getHomeDirectory
let fp = homeDir </> ".xmonad" </> "startup"
+ xmproc <- spawnPipe "xmobar"
+
config <-
- applyKeys $ def
+ applyKeys $ docks $ def
{ terminal = "alacritty"
, modMask = mod3Mask
, borderWidth = 2
@@ -49,33 +58,33 @@ main = do
, handleEventHook = fullscreenEventHook
, focusFollowsMouse = False
, clickJustFocuses = False
- }
+ , logHook = do
+ (_, _, layout) <- showLayout
- let toggleStructsKey XConfig {XMonad.modMask = modMask} = (modMask, xK_b)
+ dynamicLogWithPP $ xmobarPP {
+ ppCurrent = xmobarColor "#ff8888" "red" . printf "<fn=1>%s</fn>"
+ , ppVisible = xmobarColor "#8888ff" "" . printf "<fn=6>%s</fn>"
+ , ppHidden = xmobarColor "#888888" "" . printf "<fn=2>%s</fn>"
+ , ppWsSep = "<fn=1><fc=#808080> </fc></fn>"
+ , ppTitle =
+ xmobarColor "#808080" "" .
+ printf "<fn=3><fc=#bbbbbb>%s</fc></fn>" .
+ parseOut .
+ trunc 50
+
+ , ppSep = xmobarColor "#404040" "" " │ "
+ , ppLayout = const (fromMaybe "" layout)
+ , ppExtras = []
+ , ppOutput = hPutStrLn xmproc
+ , ppOrder = \ss ->
+ let (icons, etc) = partition ("<icon"`isPrefixOf`) ss
+ in icons ++ etc
+ }
+ }
- xmonad =<<
- statusBar
- "xmobar"
- xmobarPP {
- ppCurrent = xmobarColor "#ff8888" "red" . printf "<fn=1>%s</fn>"
- , ppVisible = xmobarColor "#8888ff" "" . printf "<fn=6>%s</fn>"
- , ppHidden = xmobarColor "#888888" "" . printf "<fn=2>%s</fn>"
- , ppWsSep = "<fn=1><fc=#808080> </fc></fn>"
- , ppTitle =
- xmobarColor "#808080" "" .
- printf "<fn=3><fc=#bbbbbb>%s</fc></fn>" .
- parseOut .
- trunc 50
+ -- let toggleStructsKey XConfig {XMonad.modMask = modMask} = (modMask, xK_b)
- , ppSep = xmobarColor "#404040" "" " │ "
- , ppLayout = const ""
- , ppExtras = [showLayout]
- , ppOrder = \ss ->
- let (icons, etc) = partition ("<icon"`isPrefixOf`) ss
- in icons ++ etc
- }
- toggleStructsKey
- config
+ xmonad config
where
parseOut :: String -> String
generated by cgit (git 2.34.1) at 2026-02-22 15:11:24 +0000