{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses,
ScopedTypeVariables, BangPatterns #-}
module Internal.LayoutDraw where

import System.Process
import Text.Printf
import Control.Arrow
import Control.Exception
import Control.Monad
import Graphics.Rendering.Cairo
import Graphics.Rendering.Cairo.Internal (Render(runRender))
import Graphics.Rendering.Cairo.Types (Cairo(Cairo))
import Control.Concurrent (threadDelay)

import System.FilePath
import XMonad
import XMonad.StackSet as S
import Data.Maybe
import System.Directory

import Internal.Layout
import Internal.Hash

showLayout :: X (Maybe String)
showLayout = do
    winset <- gets windowset
    let layout = S.layout . S.workspace . S.current $ winset
    xpm <- drawPng layout
    return $ Just $ printf "<icon=%s/>" xpm

iconSize :: (Num a) => (a, a)
iconSize = (64, 32)

drawPng :: (LayoutClass layout Window) => layout Window -> X String
drawPng l = do
    dir <- getXMonadDir
    let sixWindows = [1..(4 :: Window)]
    let stack = differentiate sixWindows
    (rects, _) <-
          runLayout
            (Workspace "0" l stack)
            (Rectangle 0 0 (fst iconSize * 30) (snd iconSize * 30))
    return ()

    let descr = description l
    let pngCacheDir = dir </> "icons" </> "cache"

    liftIO $ createDirectoryIfMissing True pngCacheDir
    let testf = dir </> "text.txt"
    let filepathPng = pngCacheDir </> (quickHash descr ++ ".png")
    let filepathXpm = pngCacheDir </> (quickHash descr ++ ".xpm")

    let colors = [
           -- (1.0, 1.0, 1.0),
           -- (0.9, 0.9, 1.0),
           -- (0.8, 0.8, 1.0),
           -- (0.7, 0.7, 1.0),
           (0.8, 0.6, 0.6),
           (0.8, 0.5, 0.5),
           (0.8, 0.4, 0.4),
           (0.8, 0.3, 0.3),
           (0.8, 0.2, 0.2),
           (0.8, 0.1, 0.1),
           (0.8, 0.0, 0.0)
          ]

    exists <- liftIO $ doesFileExist filepathXpm
    when (not exists) $
      liftIO $ do
        withImageSurface FormatARGB32 64 32 $ \surface -> do
            renderWith surface $ do
              setLineCap LineCapButt
              setLineJoin LineJoinMiter

              forM_ (reverse $ zip (map (second extraPad) rects) colors) $
                \((wind, Rectangle x y w h), (r, g, b)) -> do
                  setSourceRGBA r g b 1

                  rectangle
                    (fromIntegral $ floor (fromIntegral x / 30.0))
                    (fromIntegral $ floor (fromIntegral y / 30.0))
                    (fromIntegral $ floor (fromIntegral w / 30.0))
                    (fromIntegral $ floor (fromIntegral h / 30.0))

                  fill

            surfaceWriteToPNG surface filepathPng

            out <- readProcessWithExitCode
              "/usr/bin/convert"
              [filepathPng, filepathXpm]
              ""
            return ()

    return filepathXpm
    where
      extraPad (Rectangle x y w h) =
        Rectangle (x + 100) (y + 100) (w - 100) (h - 100)
      -- padR (Rectangle x y w h) =
      --   Rectangle x y (max 1 $ w - 120) (max 1 $ h - 120)

newtype InterceptLayout l a =
    InterceptLayout {
       unIntercept :: (l a)
    } deriving (Show, Read)

instance (LayoutClass l Window) => LayoutClass (InterceptLayout l) Window where
    runLayout (Workspace t l s) rect = do
      (rects, mr) <- runLayout (Workspace t (unIntercept l) s) rect
      return (rects, fmap InterceptLayout mr)

    handleMessage this mesg = do
      ret <- handleMessage (unIntercept this) mesg
      -- mapM_ drawThing ret
      return (InterceptLayout <$> ret)

    description = ("Intercepted "++) . description . unIntercept