{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.DecorationEx.Geometry
-- Description :  Type class which is responsible for defining the placement
--                of window decorations
-- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  portnov84@rambler.ru
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module defines @DecorationGeometry@ type class, and default implementation for it.
-----------------------------------------------------------------------------

module XMonad.Layout.DecorationEx.Geometry (
    DecorationGeometry (..),
    DefaultGeometry (..)
  ) where

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import qualified XMonad.Layout.Decoration as D

-- | Decoration geometry class.
-- Decoration geometry is responsible for placement of window decorations: whether
-- they should be on the top of the window or on the bottom, should they go for 
-- full window width or only be of certain width, etc.
-- This does not know what will be drawn inside decorations.
class (Read (geom a), Show (geom a),
       Eq a)
    => DecorationGeometry geom a where

    -- | Give a name to decoration geometry implementation.
    describeGeometry :: geom a -> String

    -- | Reduce original window size to make space for decoration, if necessary.
    shrinkWindow :: geom a -> Rectangle -> Rectangle -> Rectangle
    shrinkWindow geom a
_ (Rectangle Position
_ Position
_ Dimension
_ Dimension
dh) (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x (Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
dh) Dimension
w (Dimension
h forall a. Num a => a -> a -> a
- Dimension
dh)

    -- | The pure version of the main method, 'decorate'.
    -- The method should return a rectangle where to place window decoration,
    -- or 'Nothing' if this window is not to be decorated.
    pureDecoration :: geom a          -- ^ Decoration geometry instance
                   -> Rectangle       -- ^ Screen rectangle
                   -> W.Stack a       -- ^ Current stack of windows being displayed
                   -> [(a,Rectangle)] -- ^ Set of all windows with their corresponding rectangle
                   -> (a,Rectangle)   -- ^ Window being decorated and its rectangle
                   -> Maybe Rectangle

    -- | The method should return a rectangle where to place window decoration,
    -- or 'Nothing' if this window is not to be decorated.
    decorateWindow :: geom a           -- ^ Decoration geometry instance
                   -> Rectangle        -- ^ Screen rectangle
                   -> W.Stack a        -- ^ Current stack of windows being displayed
                   -> [(a, Rectangle)] -- ^ Set of all windows with their corresponding rectangle
                   -> (a, Rectangle)   -- ^ Window being decorated and its rectangle
                   -> X (Maybe Rectangle)
    decorateWindow geom a
geom Rectangle
r Stack a
s [(a, Rectangle)]
wrs (a, Rectangle)
wr = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (geom :: * -> *) a.
DecorationGeometry geom a =>
geom a
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
-> (a, Rectangle)
-> Maybe Rectangle
pureDecoration geom a
geom Rectangle
r Stack a
s [(a, Rectangle)]
wrs (a, Rectangle)
wr

-- | Data type for default implementation of 'DecorationGeometry'.
-- This defines simple decorations: a horizontal bar at the top of each window,
-- running for full width of the window.
newtype DefaultGeometry a = DefaultGeometry {
    forall a. DefaultGeometry a -> Dimension
gDecorationHeight :: Dimension
  }
  deriving (ReadPrec [DefaultGeometry a]
ReadPrec (DefaultGeometry a)
ReadS [DefaultGeometry a]
forall a. ReadPrec [DefaultGeometry a]
forall a. ReadPrec (DefaultGeometry a)
forall a. Int -> ReadS (DefaultGeometry a)
forall a. ReadS [DefaultGeometry a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DefaultGeometry a]
$creadListPrec :: forall a. ReadPrec [DefaultGeometry a]
readPrec :: ReadPrec (DefaultGeometry a)
$creadPrec :: forall a. ReadPrec (DefaultGeometry a)
readList :: ReadS [DefaultGeometry a]
$creadList :: forall a. ReadS [DefaultGeometry a]
readsPrec :: Int -> ReadS (DefaultGeometry a)
$creadsPrec :: forall a. Int -> ReadS (DefaultGeometry a)
Read, Int -> DefaultGeometry a -> ShowS
forall a. Int -> DefaultGeometry a -> ShowS
forall a. [DefaultGeometry a] -> ShowS
forall a. DefaultGeometry a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefaultGeometry a] -> ShowS
$cshowList :: forall a. [DefaultGeometry a] -> ShowS
show :: DefaultGeometry a -> String
$cshow :: forall a. DefaultGeometry a -> String
showsPrec :: Int -> DefaultGeometry a -> ShowS
$cshowsPrec :: forall a. Int -> DefaultGeometry a -> ShowS
Show)

instance Eq a => DecorationGeometry DefaultGeometry a where
  describeGeometry :: DefaultGeometry a -> String
describeGeometry DefaultGeometry a
_ = String
"Default"

  pureDecoration :: DefaultGeometry a
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
-> (a, Rectangle)
-> Maybe Rectangle
pureDecoration (DefaultGeometry {Dimension
gDecorationHeight :: Dimension
gDecorationHeight :: forall a. DefaultGeometry a -> Dimension
..}) Rectangle
_ Stack a
s [(a, Rectangle)]
_ (a
w, Rectangle Position
x Position
y Dimension
windowWidth Dimension
windowHeight) =
      if forall a. Eq a => Stack a -> a -> Bool
D.isInStack Stack a
s a
w Bool -> Bool -> Bool
&& (Dimension
gDecorationHeight forall a. Ord a => a -> a -> Bool
< Dimension
windowHeight)
        then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
windowWidth Dimension
gDecorationHeight
        else forall a. Maybe a
Nothing

instance Default (DefaultGeometry a) where
  def :: DefaultGeometry a
def = forall a. Dimension -> DefaultGeometry a
DefaultGeometry Dimension
20