module Rahm.Desktop.Dzen.WorkspaceSelect where

import Control.Arrow (Arrow (first, second))
import Control.Concurrent (threadDelay)
import Control.Monad.Trans.Maybe (MaybeT (runMaybeT))
import Data.Function (fix)
import Data.List (find, sortBy)
import Data.Ord (comparing)
import Data.Word
import qualified Graphics.X11 as X
import Rahm.Desktop.Common (gotoWorkspace)
import Rahm.Desktop.StackSet as W
import Rahm.Desktop.Submap (ButtonOrKeyEvent (ButtonPress), nextButton, nextButtonOrKeyEvent)
import System.IO
import Text.Printf (printf)
import XMonad
import XMonad.Util.Run (spawnPipe)

dzenSize :: (Integral a) => a
dzenSize = 100

data ScreenType = Current | Visible | Hidden

displayDzenSelection :: X ()
displayDzenSelection = do
  (W.StackSet cur vis other _floating) <- gets windowset

  let allWorkspaces :: [(W.Workspace WorkspaceId (Layout Window) Window, ScreenType)]
      allWorkspaces =
        sortBy (comparing (W.tag . fst)) $
          filter (not . null . W.integrate' . W.stack . fst) $
            ((W.workspace cur, Current) : map ((,Visible) . W.workspace) vis) ++ map (,Hidden) other
      (SD rect) = W.screenDetail cur
      dzenRects = calculatePositions rect allWorkspaces
      rectsToWorkspaces = map (second (first W.tag)) dzenRects

  dzenPipes <- mapM (uncurry launchDzen) rectsToWorkspaces

  fix $ \retry -> do
    evt <- runMaybeT nextButtonOrKeyEvent

    case evt of
      Nothing -> return () -- timeout
      Just (ButtonPress _ b) | b == button1 -> do
        withDisplay $ \d -> do
          (_, _, _, fi -> cx, fi -> cy, _, _, _) <-
            io $ X.queryPointer d =<< rootWindow d 0
          case find (\(r, _) -> pointWithin cx cy r) rectsToWorkspaces of
            Just (_, (ws, _)) -> gotoWorkspace ws
            Nothing -> return ()
      _ -> retry

  io $ do
    mapM_ hClose dzenPipes

  return ()
  where
    fi :: (Integral a, Integral b) => a -> b
    fi = fromIntegral

    toInt :: (Integral a) => a -> Int
    toInt = fromIntegral

    -- Returns, starting x, dzen width
    calculatePositions :: Rectangle -> [a] -> [(Rectangle, a)]
    calculatePositions (Rectangle (toInt -> x) (toInt -> y) (toInt -> w) (toInt -> h)) as =
      let nas = length as
          cellSize = (w `div` nas)
          y' = fi $ (h `div` 2) - (toInt cellSize `div` 2)
          sz = min 200 (cellSize * 9 `div` 10)
       in zipWith
            (\x' a -> (embedRectangle (Rectangle (fi x') (fi y') (fi cellSize) (fi cellSize)) sz sz, a))
            [x, x + cellSize ..]
            as

    embedRectangle :: Rectangle -> Int -> Int -> Rectangle
    embedRectangle r@(Rectangle x y w h) w' h' | w' > fi w || h' > fi h = r
    embedRectangle (Rectangle x y w h) w' h' =
      Rectangle
        (x + fi (w `div` 2) - fi (w' `div` 2))
        (y + fi (h `div` 2) - fi (h' `div` 2))
        (fi w')
        (fi h')

    launchDzen :: Rectangle -> (String, ScreenType) -> X Handle
    launchDzen (Rectangle x y w h) (wsTag, screenType) = do
      pipe <-
        spawnPipe
          ( printf
              "dzen2 -fn \"Monofur Nerd Font:size=15:style=bold\" -x %d -y %d -w %d -h %d -bg '%s' -fg '#000000'"
              x
              y
              w
              h
              ( case screenType of
                  Current -> "#ff8888"
                  Visible -> "#8888ff"
                  Hidden -> "#888888"
              )
          )

      io $ do
        hPutStrLn pipe wsTag
        hFlush pipe

      return pipe