1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
ScopedTypeVariables, BangPatterns #-}
module Internal.LayoutDraw where
import System.IO
import System.Process
import Text.Printf
import Control.Arrow
import Control.Exception
import Control.Monad
import Graphics.Rendering.Cairo
import Graphics.Rendering.Cairo.Internal (Render(runRender))
import Graphics.Rendering.Cairo.Types (Cairo(Cairo))
import Control.Concurrent (threadDelay)
import System.FilePath
import XMonad
import XMonad.StackSet as S
import Data.Maybe
import System.Directory
import Internal.Layout
import Internal.Hash
showLayout :: X (Bool, String, Maybe String)
showLayout = do
winset <- gets windowset
let layout = S.layout . S.workspace . S.current $ winset
(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 (Bool, String)
drawPng l = do
dir <- getXMonadDir
let sixWindows = [1..(4 :: Window)]
let stack = differentiate sixWindows
(rects, _) <-
runLayout
(Workspace "0" l stack)
(Rectangle 0 0 (fst iconSize * 30) (snd iconSize * 30))
return ()
let descr = description l
let pngCacheDir = dir </> "icons" </> "cache"
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)
-- padR (Rectangle x y w h) =
-- Rectangle x y (max 1 $ w - 120) (max 1 $ h - 120)
newtype InterceptLayout l a =
InterceptLayout {
unIntercept :: (l a)
} deriving (Show, Read)
instance (LayoutClass l Window) => LayoutClass (InterceptLayout l) Window where
runLayout (Workspace t l s) rect = do
(rects, mr) <- runLayout (Workspace t (unIntercept l) s) rect
return (rects, fmap InterceptLayout mr)
handleMessage this mesg = do
ret <- handleMessage (unIntercept this) mesg
-- mapM_ drawThing ret
return (InterceptLayout <$> ret)
description = ("Intercepted "++) . description . unIntercept
|
