{-# LANGUAGE DeriveAnyClass #-}

-- | The Pap layout modifier allows the user to "pop" the focused window into a
-- frame in the middle of the screen, sort of like fullscreen, but only taking
-- up a percentage of the screen rather than the whole screen so other windows
-- are still visible, alebeit typically not usable.
module Rahm.Desktop.Layout.Pop (
  Poppable(..),
  PopMessage(..),
  poppable,
  reinterpretResize) where

import XMonad
import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
import Data.Default (Default(..))
import qualified XMonad.StackSet as W

import Rahm.Desktop.Layout.ReinterpretMessage

data Poppable a = Poppable {
    -- True if the current window is popped out or not.
    isPopped :: Bool

    -- Fraction of the screen width around the window.
  , xFrac :: Float

    -- Fraction of the screen height around the window.
  , yFrac :: Float
  } deriving (Show, Read, Eq, Ord)

instance Default (Poppable a) where
  def = Poppable {
      isPopped = False
    , xFrac = 0.05
    , yFrac = 0.05
    }

-- Returns a modified layout that converts Resize (Shrink/Expand) into ResizePop
-- messages. Unfortunately this is required because a LayoutModifier has no way
-- to intercept messages and block them from propegating, which is pretty silly.
--
-- So, reinterpretResize will turn a Shrink/Expand into a ResizePop, this will
-- be consumed by the Poppable layout modifier. If the Poppable LayoutModifier
-- is not active, it will turn the ResizePop back into a Shrink/Expand and
-- forward it to the underlying layout.
reinterpretResize ::
  l a -> ModifiedLayout (ReinterpretMessage "ForPop") l a
reinterpretResize = ModifiedLayout ReinterpretMessage

poppable :: l a -> ModifiedLayout Poppable l a
poppable = ModifiedLayout def

-- Message to control the state of the popped layouts modifier.
data PopMessage = TogglePop | Pop | Unpop | ResizePop Float
  deriving (Typeable, Show, Eq, Ord, Message)

instance DoReinterpret "ForPop" where
  reinterpretMessage _ (fromMessage -> Just mess) =
    return $ Just $ SomeMessage $
      case mess of
        Shrink -> ResizePop (-0.05)
        Expand -> ResizePop 0.05

  reinterpretMessage _ _ = return Nothing

instance (Eq a) => LayoutModifier Poppable a where

  -- If the current layout is not popped, then just return what the underlying
  -- layout returned.
  redoLayout Poppable { isPopped = False } _ _ returned =
     return (returned, Nothing)

  -- Can't do anything with an empty stack.
  redoLayout _ _ Nothing returned = return (returned, Nothing)
  
  redoLayout self (Rectangle x y w h) (Just (W.focus -> focused)) returned =
      return ((focused, newRect) : remaining, Nothing)
    where
      remaining = filter ((/=focused) . fst) returned
      wp = floor $ fromIntegral w * xFrac self
      hp = floor $ fromIntegral h * yFrac self
      newRect = Rectangle
        (x + wp)
        (y + hp)
        (w - fromIntegral (wp * 2))
        (h - fromIntegral (hp * 2))

  -- Handle the Pop messages associated with this layout.
  handleMessOrMaybeModifyIt self (fromMessage -> Just mess) =
    return $ Just $ case mess of
      TogglePop -> Left $ self { isPopped = not (isPopped self) }
      Pop -> Left $ self { isPopped = True }
      Unpop -> Left $ self { isPopped = False }
      ResizePop amt | isPopped self ->
          Left $ self {
            xFrac = guard (xFrac self + amt),
            yFrac = guard (yFrac self + amt)
          }
      ResizePop amt -> Right $ SomeMessage $
        if amt > 0 then Expand else Shrink
    where
      guard = min 0.45 . max 0

  handleMessOrMaybeModifyIt _ _ = return Nothing