summaryrefslogtreecommitdiffstats
path: root/src/Pager
diff options
context:
space:
mode:
Diffstat (limited to 'src/Pager')
-rw-r--r--src/Pager/Rasterizer.hs131
-rw-r--r--src/Pager/Types.hs20
2 files changed, 150 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..2cec025 100644
--- a/src/Pager/Types.hs
+++ b/src/Pager/Types.hs
@@ -5,6 +5,24 @@ import Data.Aeson.TH (Options(fieldLabelModifier), deriveJSON, defaultOptions)
import Data.Text (Text)
+data Action
+ = None
+ -- | FocusWindow Int (Maybe Text)
+ | FocusWorkspace Text
+ -- | MoveWindowToWorkspace Int Text
+ -- | CopyWindowToWorkspace Int Text
+ | Batch Action Action
+
+instance Monoid Action where
+ mempty = None
+
+instance Semigroup Action where
+ x <> None = x
+ None <> x = x
+ Batch x1 x2 <> Batch x3 x4 = x1 <> x2 <> x3 <> x4
+ Batch x1 x2 <> x3 = x1 <> x2 <> x3
+ x1 <> x2 = Batch x1 x2
+
data Geometry = Geometry
{ geometry_x :: Int
, geometry_y :: Int
@@ -24,7 +42,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)