{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module XMonad.Layout.FixedColumn (
FixedColumn(..)
) where
import Graphics.X11.Xlib (Window, rect_width)
import Graphics.X11.Xlib.Extras ( getWMNormalHints
, getWindowAttributes
, sh_base_size
, sh_resize_inc
, wa_border_width)
import XMonad.Prelude (fromMaybe, msum, (<&>))
import XMonad.Core (X, LayoutClass(..), fromMessage, io, withDisplay)
import XMonad.Layout (Resize(..), IncMasterN(..), tile)
import XMonad.StackSet as W
data FixedColumn a = FixedColumn !Int
!Int
!Int
!Int
deriving (ReadPrec [FixedColumn a]
ReadPrec (FixedColumn a)
Int -> ReadS (FixedColumn a)
ReadS [FixedColumn a]
(Int -> ReadS (FixedColumn a))
-> ReadS [FixedColumn a]
-> ReadPrec (FixedColumn a)
-> ReadPrec [FixedColumn a]
-> Read (FixedColumn a)
forall a. ReadPrec [FixedColumn a]
forall a. ReadPrec (FixedColumn a)
forall a. Int -> ReadS (FixedColumn a)
forall a. ReadS [FixedColumn a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FixedColumn a]
$creadListPrec :: forall a. ReadPrec [FixedColumn a]
readPrec :: ReadPrec (FixedColumn a)
$creadPrec :: forall a. ReadPrec (FixedColumn a)
readList :: ReadS [FixedColumn a]
$creadList :: forall a. ReadS [FixedColumn a]
readsPrec :: Int -> ReadS (FixedColumn a)
$creadsPrec :: forall a. Int -> ReadS (FixedColumn a)
Read, Int -> FixedColumn a -> ShowS
[FixedColumn a] -> ShowS
FixedColumn a -> String
(Int -> FixedColumn a -> ShowS)
-> (FixedColumn a -> String)
-> ([FixedColumn a] -> ShowS)
-> Show (FixedColumn a)
forall a. Int -> FixedColumn a -> ShowS
forall a. [FixedColumn a] -> ShowS
forall a. FixedColumn a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixedColumn a] -> ShowS
$cshowList :: forall a. [FixedColumn a] -> ShowS
show :: FixedColumn a -> String
$cshow :: forall a. FixedColumn a -> String
showsPrec :: Int -> FixedColumn a -> ShowS
$cshowsPrec :: forall a. Int -> FixedColumn a -> ShowS
Show)
instance LayoutClass FixedColumn Window where
doLayout :: FixedColumn Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (FixedColumn Window))
doLayout (FixedColumn Int
nmaster Int
_ Int
ncol Int
fallback) Rectangle
r Stack Window
s = do
[Int]
fws <- (Window -> X Int) -> [Window] -> X [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Int -> Window -> X Int
widthCols Int
fallback Int
ncol) [Window]
ws
let frac :: Rational
frac = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
nmaster [Int]
fws) Int -> Dimension -> Rational
forall a a a. (Fractional a, Integral a, Integral a) => a -> a -> a
// Rectangle -> Dimension
rect_width Rectangle
r
rs :: [Rectangle]
rs = Rational -> Rectangle -> Int -> Int -> [Rectangle]
tile Rational
frac Rectangle
r Int
nmaster ([Window] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
ws)
([(Window, Rectangle)], Maybe (FixedColumn Window))
-> X ([(Window, Rectangle)], Maybe (FixedColumn Window))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Window] -> [Rectangle] -> [(Window, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
ws [Rectangle]
rs, Maybe (FixedColumn Window)
forall a. Maybe a
Nothing)
where ws :: [Window]
ws = Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate Stack Window
s
a
x // :: a -> a -> a
// a
y = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y
pureMessage :: FixedColumn Window -> SomeMessage -> Maybe (FixedColumn Window)
pureMessage (FixedColumn Int
nmaster Int
delta Int
ncol Int
fallback) SomeMessage
m =
[Maybe (FixedColumn Window)] -> Maybe (FixedColumn Window)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(Resize -> FixedColumn Window)
-> Maybe Resize -> Maybe (FixedColumn Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resize -> FixedColumn Window
forall a. Resize -> FixedColumn a
resize (SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
,(IncMasterN -> FixedColumn Window)
-> Maybe IncMasterN -> Maybe (FixedColumn Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IncMasterN -> FixedColumn Window
forall a. IncMasterN -> FixedColumn a
incmastern (SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)]
where resize :: Resize -> FixedColumn a
resize Resize
Shrink
= Int -> Int -> Int -> Int -> FixedColumn a
forall a. Int -> Int -> Int -> Int -> FixedColumn a
FixedColumn Int
nmaster Int
delta (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
ncol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
delta) Int
fallback
resize Resize
Expand
= Int -> Int -> Int -> Int -> FixedColumn a
forall a. Int -> Int -> Int -> Int -> FixedColumn a
FixedColumn Int
nmaster Int
delta (Int
ncol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta) Int
fallback
incmastern :: IncMasterN -> FixedColumn a
incmastern (IncMasterN Int
d)
= Int -> Int -> Int -> Int -> FixedColumn a
forall a. Int -> Int -> Int -> Int -> FixedColumn a
FixedColumn (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
nmasterInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)) Int
delta Int
ncol Int
fallback
description :: FixedColumn Window -> String
description FixedColumn Window
_ = String
"FixedColumn"
widthCols :: Int -> Int -> Window -> X Int
widthCols :: Int -> Int -> Window -> X Int
widthCols Int
inc Int
n Window
w = (Display -> X Int) -> X Int
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X Int) -> X Int) -> (Display -> X Int) -> X Int
forall a b. (a -> b) -> a -> b
$ \Display
d -> IO Int -> X Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Int -> X Int) -> IO Int -> X Int
forall a b. (a -> b) -> a -> b
$ do
SizeHints
sh <- Display -> Window -> IO SizeHints
getWMNormalHints Display
d Window
w
Int
bw <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowAttributes -> CInt
wa_border_width (WindowAttributes -> Int) -> IO WindowAttributes -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d Window
w
let widthHint :: (SizeHints -> f (a, b)) -> f b
widthHint SizeHints -> f (a, b)
f = SizeHints -> f (a, b)
f SizeHints
sh f (a, b) -> ((a, b) -> b) -> f b
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> b) -> ((a, b) -> a) -> (a, b) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst
oneCol :: Int
oneCol = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
inc (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (SizeHints -> Maybe (Dimension, Dimension)) -> Maybe Int
forall (f :: * -> *) a b b.
(Functor f, Integral a, Num b) =>
(SizeHints -> f (a, b)) -> f b
widthHint SizeHints -> Maybe (Dimension, Dimension)
sh_resize_inc
base :: Int
base = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (SizeHints -> Maybe (Dimension, Dimension)) -> Maybe Int
forall (f :: * -> *) a b b.
(Functor f, Integral a, Num b) =>
(SizeHints -> f (a, b)) -> f b
widthHint SizeHints -> Maybe (Dimension, Dimension)
sh_base_size
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bw Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
oneCol