{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
module XMonad.Layout.CenteredIfSingle
(
centeredIfSingle, CenteredIfSingle
) where
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Prelude (fi)
data CenteredIfSingle a = CenteredIfSingle !Double !Double
deriving (Int -> CenteredIfSingle a -> ShowS
forall a. Int -> CenteredIfSingle a -> ShowS
forall a. [CenteredIfSingle a] -> ShowS
forall a. CenteredIfSingle a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CenteredIfSingle a] -> ShowS
$cshowList :: forall a. [CenteredIfSingle a] -> ShowS
show :: CenteredIfSingle a -> String
$cshow :: forall a. CenteredIfSingle a -> String
showsPrec :: Int -> CenteredIfSingle a -> ShowS
$cshowsPrec :: forall a. Int -> CenteredIfSingle a -> ShowS
Show, ReadPrec [CenteredIfSingle a]
ReadPrec (CenteredIfSingle a)
ReadS [CenteredIfSingle a]
forall a. ReadPrec [CenteredIfSingle a]
forall a. ReadPrec (CenteredIfSingle a)
forall a. Int -> ReadS (CenteredIfSingle a)
forall a. ReadS [CenteredIfSingle a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CenteredIfSingle a]
$creadListPrec :: forall a. ReadPrec [CenteredIfSingle a]
readPrec :: ReadPrec (CenteredIfSingle a)
$creadPrec :: forall a. ReadPrec (CenteredIfSingle a)
readList :: ReadS [CenteredIfSingle a]
$creadList :: forall a. ReadS [CenteredIfSingle a]
readsPrec :: Int -> ReadS (CenteredIfSingle a)
$creadsPrec :: forall a. Int -> ReadS (CenteredIfSingle a)
Read)
instance LayoutModifier CenteredIfSingle Window where
pureModifier :: CenteredIfSingle Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> ([(Window, Rectangle)], Maybe (CenteredIfSingle Window))
pureModifier (CenteredIfSingle Double
ratioX Double
ratioY) Rectangle
r Maybe (Stack Window)
_ [(Window
onlyWindow, Rectangle
_)] = ([(Window
onlyWindow, Double -> Double -> Rectangle -> Rectangle
rectangleCenterPiece Double
ratioX Double
ratioY Rectangle
r)], forall a. Maybe a
Nothing)
pureModifier CenteredIfSingle Window
_ Rectangle
_ Maybe (Stack Window)
_ [(Window, Rectangle)]
winRects = ([(Window, Rectangle)]
winRects, forall a. Maybe a
Nothing)
centeredIfSingle :: Double
-> Double
-> l a
-> ModifiedLayout CenteredIfSingle l a
centeredIfSingle :: forall (l :: * -> *) a.
Double -> Double -> l a -> ModifiedLayout CenteredIfSingle l a
centeredIfSingle Double
ratioX Double
ratioY = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall a. Double -> Double -> CenteredIfSingle a
CenteredIfSingle Double
ratioX Double
ratioY)
rectangleCenterPiece :: Double -> Double -> Rectangle -> Rectangle
rectangleCenterPiece :: Double -> Double -> Rectangle -> Rectangle
rectangleCenterPiece Double
ratioX Double
ratioY (Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
startX Position
startY Dimension
width Dimension
height
where
startX :: Position
startX = Position
rx forall a. Num a => a -> a -> a
+ Position
left
startY :: Position
startY = Position
ry forall a. Num a => a -> a -> a
+ Position
top
width :: Dimension
width = Dimension -> Position -> Dimension
newSize Dimension
rw Position
left
height :: Dimension
height = Dimension -> Position -> Dimension
newSize Dimension
rh Position
top
left :: Position
left = Dimension
rw Dimension -> Double -> Position
`scaleBy` Double
ratioX
top :: Position
top = Dimension
rh Dimension -> Double -> Position
`scaleBy` Double
ratioY
newSize :: Dimension -> Position -> Dimension
newSize :: Dimension -> Position -> Dimension
newSize Dimension
dim Position
pos = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi Dimension
dim forall a. Num a => a -> a -> a
- Position
pos forall a. Num a => a -> a -> a
* Position
2
scaleBy :: Dimension -> Double -> Position
scaleBy :: Dimension -> Double -> Position
scaleBy Dimension
dim Double
ratio = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi Dimension
dim forall a. Num a => a -> a -> a
* (Double
1.0 forall a. Num a => a -> a -> a
- Double
ratio) forall a. Fractional a => a -> a -> a
/ Double
2