diff options
Diffstat (limited to 'src/Pager')
| -rw-r--r-- | src/Pager/Sixelerator.hs | 105 | ||||
| -rw-r--r-- | src/Pager/Types.hs | 22 |
2 files changed, 121 insertions, 6 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) diff --git a/src/Pager/Types.hs b/src/Pager/Types.hs index 95dd837..a2ea5aa 100644 --- a/src/Pager/Types.hs +++ b/src/Pager/Types.hs @@ -1,10 +1,24 @@ {-# LANGUAGE TemplateHaskell #-} module Pager.Types where -import Data.Aeson.TH (Options(fieldLabelModifier), deriveJSON, defaultOptions) import Data.Text (Text) +import Scanner (Scan) +data Action + = None + | FocusWorkspace Text + +data Command = + ViewWorkspace | + ShiftWindowToWorkspace Int | + ShiftWindowToAndViewWorkspace Int + +data Event = + EResize Int Int | + EScan Scan | + EShutdown + data Geometry = Geometry { geometry_x :: Int , geometry_y :: Int @@ -24,9 +38,5 @@ 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) -$(deriveJSON defaultOptions { fieldLabelModifier = tail . dropWhile (/='_') } ''Window) -$(deriveJSON defaultOptions { fieldLabelModifier = tail . dropWhile (/='_') } ''Workspace) |