diff options
Diffstat (limited to 'src/Pager')
| -rw-r--r-- | src/Pager/Rasterizer.hs | 131 | ||||
| -rw-r--r-- | src/Pager/Types.hs | 20 |
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) |