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
120
121
122
123
124
125
126
127
128
129
130
131
|
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
-- TODO rename to Pager.Sixelerator or something
module Pager.Rasterizer where
import Data.ByteString (ByteString)
import Data.Maybe (catMaybes)
--import Graphics.X11.Xlib.Types (Dimension,Position,Rectangle(..))
import qualified Sixel
import Sixel (PaletteColor)
import State (State(..))
--import qualified XMonad.Web.Types
import Pager.Types
data WindowFeature
= WindowBackground
| WindowBorder
| FocusBackground
| FocusBorder
| UrgentBackground
| UrgentBorder
renderWorkspacePreview :: Geometry -> State -> Workspace -> ByteString
renderWorkspacePreview previewGeometry State{screenHeight,screenWidth} Workspace{..} =
Sixel.render previewGeometry rgbColors canvas
where
workspaceHeight = fromIntegral $ geometry_height previewGeometry :: Int
workspaceWidth = fromIntegral $ geometry_width previewGeometry :: Int
--workspaceX = fromIntegral $ geometry_x previewGeometry :: Int
--workspaceY = fromIntegral $ geometry_y previewGeometry
-- TODO workspaceFirstBandOffset = workspaceY - floor (fromIntegral workspaceY / 6 :: Double) * 6
-- TODO workspaceFirstBandHeight = 6 - workspaceFirstBandOffset
-- TODO workspaceSkipBandCount = floor $ fromIntegral workspaceHeight / (6 :: Double)
-- TODO? workspaceTotalBandCount = ceiling $ fromIntegral (workspaceFirstBandOffset + workspaceHeight) / (6 :: Double) :: Integer
-- TODO? workspaceLastBandHeight = workspaceHeight - (workspaceTotalBandCount - 1) * 6 + workspaceFirstBandOffset
scaleX = fromIntegral workspaceWidth / fromIntegral screenWidth :: Double
scaleY = fromIntegral workspaceHeight / fromIntegral screenHeight :: Double
-- XXX color indexes must start at 0 and be continuous (to compute sixeldata)
workspaceBackgroundColor = 0
windowBackgroundColor = 1
windowBorderColor = 2
focusBackgroundColor = 3
focusBorderColor = 4
urgentBackgroundColor = 5
urgentBorderColor = 6
rgbColors =
[ (0,0,0) -- workspace background
, (29,113,29) -- window background color
, (0,255,0) -- window border color
, (113,29,113) -- focus background color
, (255,0,255) -- focus border color
, (113,29,29) -- urgent background color
, (255,0,0) -- urgent border color
]
canvas = rasterize f (fromIntegral workspaceWidth) (fromIntegral workspaceHeight)
<> blankLine -- #ex_offsetY
where
f x y = case catMaybes (map (getWindowFeatureAt x y) workspace_windows) of
UrgentBackground:_ -> urgentBackgroundColor
UrgentBorder:_ -> urgentBorderColor
FocusBackground:_ -> focusBackgroundColor
FocusBorder:_ -> focusBorderColor
WindowBackground:_ -> windowBackgroundColor
WindowBorder:_ -> windowBorderColor
_ -> workspaceBackgroundColor
-- XXX blank line is used in conjunction with ex_offsetY to "clean up" when moving up
-- remove this together with ex_offsetY.
blankLine = replicate workspaceWidth 0
--palette = map fromIntegral [0..length rgbColors - 1]
--colors = mconcat $ map (uncurry setColorMapRegister) (zip palette rgbColors)
--channels = splitChannels palette canvas
--scanlines = toScanlines (fromIntegral workspaceWidth) channels
--bitbands = toBitbands (fromIntegral workspaceWidth) scanlines
--bitbands6 = toBitbands6 bitbands
--bytebands = toBytebands bitbands6
--sixelbands = toSixelbands bytebands
--sixelbandsRLE = toSixelbandsRLE sixelbands
--sixeldata = toSixeldata (fromIntegral workspaceX) sixelbandsRLE
getWindowFeatureAt x y Window{..} =
if isBorder then
if window_urgent then
Just UrgentBorder
else if window_focused then
Just FocusBorder
else
Just WindowBorder
else if isBackground then
if window_urgent then
Just UrgentBackground
else if window_focused then
Just FocusBackground
else
Just WindowBackground
else
Nothing
where
w_x = round (scaleX * fromIntegral (geometry_x window_geometry))
w_y = round (scaleY * fromIntegral (geometry_y window_geometry))
w_width = round (scaleX * fromIntegral (geometry_width window_geometry))
w_height = round (scaleY * fromIntegral (geometry_height window_geometry))
isBackground =
(w_x <= x && x < w_x + w_width) &&
(w_y <= y && y < w_y + w_height)
isBorder =
(w_x <= x && x < w_x + w_width) &&
(w_y <= y && y < w_y + w_height) &&
(x == w_x || x == w_x + w_width - 1 || y == w_y || y == w_y + w_height - 1)
rasterize :: (Int -> Int -> PaletteColor) -> Int -> Int -> [PaletteColor]
rasterize f width height =
map f' ([0..width * height - 1] :: [Int])
where
f' index = f x y
where
x = fromIntegral $ index `mod` width
y = floor $ fromIntegral index / (fromIntegral width :: Double)
|
