1 files changed, 105 insertions, 0 deletions
diff --git a/src/Pager/Sixelerator.hs b/src/Pager/Sixelerator.hs
new file mode 100644
index 0000000..c518484
--- /dev/null
+++ b/src/Pager/Sixelerator.hs
@@ -0,0 +1,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)