{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module XMonad.Layout.CenteredMaster (
centerMaster,
topRightMaster,
CenteredMaster, TopRightMaster,
) where
import XMonad
import XMonad.Layout.LayoutModifier
import qualified XMonad.StackSet as W
import Control.Arrow (first)
type Positioner = Rectangle -> Rectangle
data CenteredMaster a = CenteredMaster deriving (ReadPrec [CenteredMaster a]
ReadPrec (CenteredMaster a)
ReadS [CenteredMaster a]
forall a. ReadPrec [CenteredMaster a]
forall a. ReadPrec (CenteredMaster a)
forall a. Int -> ReadS (CenteredMaster a)
forall a. ReadS [CenteredMaster a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CenteredMaster a]
$creadListPrec :: forall a. ReadPrec [CenteredMaster a]
readPrec :: ReadPrec (CenteredMaster a)
$creadPrec :: forall a. ReadPrec (CenteredMaster a)
readList :: ReadS [CenteredMaster a]
$creadList :: forall a. ReadS [CenteredMaster a]
readsPrec :: Int -> ReadS (CenteredMaster a)
$creadsPrec :: forall a. Int -> ReadS (CenteredMaster a)
Read,Int -> CenteredMaster a -> ShowS
forall a. Int -> CenteredMaster a -> ShowS
forall a. [CenteredMaster a] -> ShowS
forall a. CenteredMaster a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CenteredMaster a] -> ShowS
$cshowList :: forall a. [CenteredMaster a] -> ShowS
show :: CenteredMaster a -> String
$cshow :: forall a. CenteredMaster a -> String
showsPrec :: Int -> CenteredMaster a -> ShowS
$cshowsPrec :: forall a. Int -> CenteredMaster a -> ShowS
Show)
instance LayoutModifier CenteredMaster Window where
modifyLayout :: forall (l :: * -> *).
LayoutClass l Window =>
CenteredMaster Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout CenteredMaster Window
CenteredMaster = forall (l :: * -> *) a.
(LayoutClass l a, Eq a) =>
Positioner
-> Workspace String (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
applyPosition (Float -> Float -> Positioner
center (Float
5forall a. Fractional a => a -> a -> a
/Float
7) (Float
5forall a. Fractional a => a -> a -> a
/Float
7))
data TopRightMaster a = TopRightMaster deriving (ReadPrec [TopRightMaster a]
ReadPrec (TopRightMaster a)
ReadS [TopRightMaster a]
forall a. ReadPrec [TopRightMaster a]
forall a. ReadPrec (TopRightMaster a)
forall a. Int -> ReadS (TopRightMaster a)
forall a. ReadS [TopRightMaster a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TopRightMaster a]
$creadListPrec :: forall a. ReadPrec [TopRightMaster a]
readPrec :: ReadPrec (TopRightMaster a)
$creadPrec :: forall a. ReadPrec (TopRightMaster a)
readList :: ReadS [TopRightMaster a]
$creadList :: forall a. ReadS [TopRightMaster a]
readsPrec :: Int -> ReadS (TopRightMaster a)
$creadsPrec :: forall a. Int -> ReadS (TopRightMaster a)
Read,Int -> TopRightMaster a -> ShowS
forall a. Int -> TopRightMaster a -> ShowS
forall a. [TopRightMaster a] -> ShowS
forall a. TopRightMaster a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopRightMaster a] -> ShowS
$cshowList :: forall a. [TopRightMaster a] -> ShowS
show :: TopRightMaster a -> String
$cshow :: forall a. TopRightMaster a -> String
showsPrec :: Int -> TopRightMaster a -> ShowS
$cshowsPrec :: forall a. Int -> TopRightMaster a -> ShowS
Show)
instance LayoutModifier TopRightMaster Window where
modifyLayout :: forall (l :: * -> *).
LayoutClass l Window =>
TopRightMaster Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout TopRightMaster Window
TopRightMaster = forall (l :: * -> *) a.
(LayoutClass l a, Eq a) =>
Positioner
-> Workspace String (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
applyPosition (Float -> Float -> Positioner
topRight (Float
3forall a. Fractional a => a -> a -> a
/Float
7) (Float
1forall a. Fractional a => a -> a -> a
/Float
2))
centerMaster :: LayoutClass l a => l a -> ModifiedLayout CenteredMaster l a
centerMaster :: forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout CenteredMaster l a
centerMaster = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall a. CenteredMaster a
CenteredMaster
topRightMaster :: LayoutClass l a => l a -> ModifiedLayout TopRightMaster l a
topRightMaster :: forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout TopRightMaster l a
topRightMaster = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall a. TopRightMaster a
TopRightMaster
applyPosition :: (LayoutClass l a, Eq a) =>
Positioner
-> W.Workspace WorkspaceId (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
applyPosition :: forall (l :: * -> *) a.
(LayoutClass l a, Eq a) =>
Positioner
-> Workspace String (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
applyPosition Positioner
pos Workspace String (l a) a
wksp Rectangle
rect = do
let stack :: Maybe (Stack a)
stack = forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack Workspace String (l a) a
wksp
let ws :: [a]
ws = forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack a)
stack
case [a]
ws of
[] -> forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (l a) a
wksp Rectangle
rect
(a
firstW : [a]
other) -> do
let filtStack :: Maybe (Stack a)
filtStack = Maybe (Stack a)
stack forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
W.filter (a
firstW forall a. Eq a => a -> a -> Bool
/=)
([(a, Rectangle)], Maybe (l a))
wrs <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (Workspace String (l a) a
wksp {stack :: Maybe (Stack a)
W.stack = Maybe (Stack a)
filtStack}) Rectangle
rect
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((a
firstW, forall a. Positioner -> [a] -> Positioner
place Positioner
pos [a]
other Rectangle
rect) forall a. a -> [a] -> [a]
:) ([(a, Rectangle)], Maybe (l a))
wrs
place :: Positioner -> [a] -> Rectangle -> Rectangle
place :: forall a. Positioner -> [a] -> Positioner
place Positioner
_ [] Rectangle
rect = Rectangle
rect
place Positioner
pos [a]
_ Rectangle
rect = Positioner
pos Rectangle
rect
topRight :: Float -> Float -> Rectangle -> Rectangle
topRight :: Float -> Float -> Positioner
topRight Float
rx Float
ry (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
sy Dimension
w Dimension
h
where w :: Dimension
w = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw forall a. Num a => a -> a -> a
* Float
rx)
h :: Dimension
h = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh forall a. Num a => a -> a -> a
* Float
ry)
x :: Position
x = Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
swforall a. Num a => a -> a -> a
-Dimension
w)
center :: Float -> Float -> Rectangle -> Rectangle
center :: Float -> Float -> Positioner
center Float
rx Float
ry (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w Dimension
h
where w :: Dimension
w = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw forall a. Num a => a -> a -> a
* Float
rx)
h :: Dimension
h = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh forall a. Num a => a -> a -> a
* Float
ry)
x :: Position
x = Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
swforall a. Num a => a -> a -> a
-Dimension
w) forall a. Integral a => a -> a -> a
`div` Position
2
y :: Position
y = Position
sy forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
shforall a. Num a => a -> a -> a
-Dimension
h) forall a. Integral a => a -> a -> a
`div` Position
2