{-# 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)