wipwip

2 files changed, 132 insertions, 1 deletions

diff --git a/src/Pager/Rasterizer.hs b/src/Pager/Rasterizer.hs
new file mode 100644
index 0000000..821e4cc
--- /dev/null
+++ b/src/Pager/Rasterizer.hs
@@ -0,0 +1,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)
diff --git a/src/Pager/Types.hs b/src/Pager/Types.hs
index 95dd837..8a3b815 100644
--- a/src/Pager/Types.hs
+++ b/src/Pager/Types.hs
@@ -24,7 +24,7 @@ data Workspace = Workspace
   { workspace_geometry :: Geometry
   , workspace_focused :: Bool
   , workspace_name :: Text
-  , workspace_windows :: [Window]
+  , workspace_windows :: [Window] -- sorted by z-order, earlier windows overlap later ones
   }
 
 $(deriveJSON defaultOptions { fieldLabelModifier = tail . dropWhile (/='_') } ''Geometry)