{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
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
class (Read (geom a), Show (geom a),
Eq a)
=> DecorationGeometry geom a where
describeGeometry :: geom a -> String
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)
pureDecoration :: geom a
-> Rectangle
-> W.Stack a
-> [(a,Rectangle)]
-> (a,Rectangle)
-> Maybe Rectangle
decorateWindow :: geom a
-> Rectangle
-> W.Stack a
-> [(a, Rectangle)]
-> (a, 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
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