{-# LANGUAGE FlexibleContexts, TypeSynonymInstances, MultiParamTypeClasses, ScopedTypeVariables #-}

-- | A layout modifier, that "pops" the focused window, making it
-- | larger and moving it somewhat towards the centre
-- | This can be useful if your usual layout provides a good overview, but you
-- | often find yourself full-screening windows are focussing them to get to the
-- | details they contain.
-- | If you switch focus, the previously focussed window will return to it's usual
-- | size, and the newly focussed window will be popped instead.
-- | The "strengh" parameter determines how much "pop" will be applied - the
-- | larger this number the more of the screen the popped window will occupy.
-- | As the strength paramater tends to infinity, the popped window becomes
-- | full-screen.
-- | I use this LayoutModifier in a MultiToggle group alongsize NBFULL, on
-- | adjacent keys ("M-;" and "M-S-;") to give me quickly accessible options
-- | around zooming a window.

module PopOnFocus where

import Data.Map (Map)
import Data.Ratio
import qualified Data.Map as Map
import qualified Data.Set as Set

import XMonad
import XMonad.Layout.MultiToggle
import qualified XMonad.StackSet as S
import XMonad.Layout.LayoutModifier
import XMonad.Prelude ( partition )

data POPALL = POPALL deriving (Eq, Show, Read)

-- This transformer doesn't actually do anything - is just exists so we can query if it's on or off
instance Transformer POPALL Window where
    transform _ x k = k x id

data PopOnFocus a =
  PopOnFocus
    { globalPop :: !Bool
    , defaultGlobalStrength :: !Int
    , globalStrength :: !Int
    , windowStrength :: !(Map Window Int)
    } deriving ( Read, Show, Eq )

data PopOnFocusMessage = MakeBigger Window | MakeSmaller Window | MakeNormal Window

instance Message PopOnFocusMessage

popOnFocus :: LayoutClass l Window => Int -> l Window -> ModifiedLayout PopOnFocus l Window
popOnFocus globalStrength
  | globalStrength >= 1 = ModifiedLayout $ PopOnFocus False globalStrength globalStrength Map.empty

instance LayoutModifier PopOnFocus Window where
    modifierDescription _ = "PopOnFocus"
    pureModifier m rect (Just (S.Stack focused _ _)) wrs =
      case if (globalPop m)
             then Just (globalStrength m)
             else Map.lookup focused (windowStrength m)
        of Nothing -> (wrs, Nothing)
           Just strength ->
             let (toMax, rest) = partition (\(w, _) -> w == focused) wrs
                 maxed = map (\(w, before) -> (w, embiggen strength before rect)) toMax
              in (maxed ++ rest, Nothing)
    pureModifier _ _ _ wrs = (wrs, Nothing)

    pureMess m@(PopOnFocus { globalPop = True })  mess =
      case fromMessage mess
        of Nothing -> Nothing
           Just (MakeBigger w) -> Just (m { globalStrength = succ (globalStrength m)})
           Just (MakeSmaller w) -> Just (m { globalStrength = max 1 (pred (globalStrength m))})
           Just (MakeNormal w) -> Just (m { globalStrength = defaultGlobalStrength m})
    pureMess m@(PopOnFocus { globalPop = False })  mess =
      case fromMessage mess
        of Nothing -> Nothing
           Just (MakeBigger w) ->
             let tagged' = Map.alter (\f -> case f
                                             of Nothing -> Just 1
                                                Just x -> Just (succ x))
                             w (windowStrength m)
              in Just (m { windowStrength = tagged'})
           Just (MakeSmaller w) ->
             let tagged' = Map.alter (\f -> case f
                                             of Nothing -> Nothing
                                                Just x ->
                                                  if x == 1 then
                                                    Nothing
                                                else
                                                    Just (pred x))
                             w (windowStrength m)
              in Just (m { windowStrength = tagged' })
           Just (MakeNormal w) -> Just (m { windowStrength = Map.delete w (windowStrength m)})

    handleMess m0 mess | Just Hide <- fromMessage mess             = doUnhook
                       | Just ReleaseResources <- fromMessage mess = doUnhook
                       | otherwise =
                          case pureMess m0 mess
                            of Nothing -> return Nothing
                               Just m1 -> withWindowSet (\ws -> return $ Just $ m1 { windowStrength =  removeDeadWindows ws (windowStrength m1)})
      where
        doUnhook = do unhook m0; return Nothing

        removeDeadWindows ws tagged = Map.filterWithKey (\w _ -> Set.member w ws') tagged
            where
                ws' = Set.fromList $ S.allWindows ws

    redoLayout m r ms wrs = do
        m' <- updateFlag m
        hook m'
        case pureModifier m' r ms wrs
          of (wrs, Nothing) -> return (wrs, Just m')
             (wrs, Just m'') -> return (wrs, Just m'')


updateFlag m = do
  popAll <- withWindowSet (isToggleActive POPALL . S.workspace . S.current)
  case popAll
    of Nothing -> return m
       Just popAll' -> return m { globalPop = popAll' }

embiggen :: Int -> Rectangle -> Rectangle -> Rectangle
embiggen strength inner outter = fromCentreSpan icx' icy' icw' ich'
  where
    (icx, icy, iw, ih) = toCentreSpan inner
    (ocx, ocy, ow, oh) = toCentreSpan outter
    (icx', icw') = transformLineSegment strength icx iw ocx ow
    (icy', ich') = transformLineSegment strength icy ih ocy oh

-- The function controls how we transform the windows.
-- It's applied twice, once for each dimension.
-- The inner segment is made more like the outter segment, depending on the strength parameter.
-- Note that we move the centre of the segment a bit more aggressively than the
-- length - this is so windows pop towards the centre, which gives a bit of a
-- sense as to where in the layout they came from
transformLineSegment :: Int -> Rational -> Rational -> Rational -> Rational -> (Rational, Rational)
transformLineSegment strength ic il oc ol = ((f2'*ic)+(f2*oc), (f'*il)+(f*ol))
  where
    f = strengthToFrac strength
    f2 = strengthToFrac (succ strength)
    f' = 1 - f
    f2' = 1 - f2

toCentreSpan :: Rectangle -> (Rational, Rational, Rational, Rational)
toCentreSpan r = (x + (w/2), y+(h/2), w, h)
  where
    x = fromIntegral $ rect_x r
    y = fromIntegral $ rect_y r
    w = fromIntegral $ rect_width r
    h =  fromIntegral $ rect_height r

fromCentreSpan :: Rational -> Rational -> Rational -> Rational -> Rectangle
fromCentreSpan cx cy w h = Rectangle (floor (cx-(w/2))) (floor (cy-(h/2))) (ceiling w) (ceiling h)

strengthToFrac n
  | n < 0 = error "strengthToFrac"
  | otherwise = fromIntegral n % (succ (fromIntegral n))