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
|
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module Pager.Sixelerator where
import Data.ByteString (ByteString)
import Data.Maybe (catMaybes)
import Pager.Types
import Sixel (PaletteColor)
import State (State(..))
import qualified Sixel
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
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
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
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)
|
