{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module XMonad.Layout.BinaryColumn (
BinaryColumn (..)
) where
import XMonad
import qualified XMonad.StackSet
import qualified Data.List
data BinaryColumn a = BinaryColumn Float Int
deriving (ReadPrec [BinaryColumn a]
ReadPrec (BinaryColumn a)
ReadS [BinaryColumn a]
forall a. ReadPrec [BinaryColumn a]
forall a. ReadPrec (BinaryColumn a)
forall a. Int -> ReadS (BinaryColumn a)
forall a. ReadS [BinaryColumn a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinaryColumn a]
$creadListPrec :: forall a. ReadPrec [BinaryColumn a]
readPrec :: ReadPrec (BinaryColumn a)
$creadPrec :: forall a. ReadPrec (BinaryColumn a)
readList :: ReadS [BinaryColumn a]
$creadList :: forall a. ReadS [BinaryColumn a]
readsPrec :: Int -> ReadS (BinaryColumn a)
$creadsPrec :: forall a. Int -> ReadS (BinaryColumn a)
Read, Int -> BinaryColumn a -> ShowS
forall a. Int -> BinaryColumn a -> ShowS
forall a. [BinaryColumn a] -> ShowS
forall a. BinaryColumn a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinaryColumn a] -> ShowS
$cshowList :: forall a. [BinaryColumn a] -> ShowS
show :: BinaryColumn a -> String
$cshow :: forall a. BinaryColumn a -> String
showsPrec :: Int -> BinaryColumn a -> ShowS
$cshowsPrec :: forall a. Int -> BinaryColumn a -> ShowS
Show)
instance XMonad.LayoutClass BinaryColumn a where
pureLayout :: BinaryColumn a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout = forall a.
BinaryColumn a -> Rectangle -> Stack a -> [(a, Rectangle)]
columnLayout
pureMessage :: BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)
pureMessage = forall a. BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)
columnMessage
columnMessage :: BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)
columnMessage :: forall a. BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)
columnMessage (BinaryColumn Float
q Int
min_size) SomeMessage
m = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Resize -> BinaryColumn a
resize (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
where
resize :: Resize -> BinaryColumn a
resize Resize
Shrink = forall a. Float -> Int -> BinaryColumn a
BinaryColumn (forall a. Ord a => a -> a -> a
max (-Float
2.0) (Float
q forall a. Num a => a -> a -> a
- Float
0.1)) Int
min_size
resize Resize
Expand = forall a. Float -> Int -> BinaryColumn a
BinaryColumn (forall a. Ord a => a -> a -> a
min Float
2.0 (Float
q forall a. Num a => a -> a -> a
+ Float
0.1)) Int
min_size
columnLayout :: BinaryColumn a
-> XMonad.Rectangle
-> XMonad.StackSet.Stack a
-> [(a, XMonad.Rectangle)]
columnLayout :: forall a.
BinaryColumn a -> Rectangle -> Stack a -> [(a, Rectangle)]
columnLayout (BinaryColumn Float
scale Int
min_size) Rectangle
rect Stack a
stack = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rects
where
ws :: [a]
ws = forall a. Stack a -> [a]
XMonad.StackSet.integrate Stack a
stack
n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws
scale_abs :: Float
scale_abs = forall a. Num a => a -> a
abs Float
scale
heights_noflip :: [Integer]
heights_noflip =
let
f :: Int -> Integer -> t -> Bool -> [Integer]
f Int
m Integer
size t
divide Bool
False = let
m_fl :: t
m_fl = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m
m_prev_fl :: t
m_prev_fl = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
m forall a. Num a => a -> a -> a
+ Int
1)
div_test :: t
div_test = forall a. Ord a => a -> a -> a
min t
divide t
m_prev_fl
value_test :: Integer
value_test = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size forall a. Fractional a => a -> a -> a
/ t
div_test) :: Integer
value_max :: Integer
value_max = Integer
size forall a. Num a => a -> a -> a
- forall a. Integral a => a -> Integer
toInteger (Int
min_size forall a. Num a => a -> a -> a
* Int
m)
(Integer
value, t
divide_next, Bool
no_room) =
if Integer
value_test forall a. Ord a => a -> a -> Bool
< Integer
value_max then
(Integer
value_test, t
divide, Bool
False)
else
(Integer
value_max, t
m_fl, Bool
True)
size_next :: Integer
size_next = Integer
size forall a. Num a => a -> a -> a
- Integer
value
m_next :: Int
m_next = Int
m forall a. Num a => a -> a -> a
- Int
1
in Integer
value
forall a. a -> [a] -> [a]
: Int -> Integer -> t -> Bool -> [Integer]
f Int
m_next Integer
size_next t
divide_next Bool
no_room
f Int
m Integer
size t
divide Bool
True = let
divide_next :: t
divide_next = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m
value_even :: t
value_even = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size forall a. Fractional a => a -> a -> a
/ t
divide)
value :: Integer
value = forall a b. (RealFrac a, Integral b) => a -> b
round t
value_even :: Integer
m_next :: Int
m_next = Int
m forall a. Num a => a -> a -> a
- Int
1
size_next :: Integer
size_next = Integer
size forall a. Num a => a -> a -> a
- Integer
value
in Integer
value
forall a. a -> [a] -> [a]
: Int -> Integer -> t -> Bool -> [Integer]
f Int
m_next Integer
size_next t
divide_next Bool
True
in forall {t}. RealFrac t => Int -> Integer -> t -> Bool -> [Integer]
f
Int
n_init Integer
size_init Float
divide_init Bool
False
where
n_init :: Int
n_init = Int
n forall a. Num a => a -> a -> a
- Int
1
size_init :: Integer
size_init = forall a. Integral a => a -> Integer
toInteger (Rectangle -> Dimension
rect_height Rectangle
rect)
divide_init :: Float
divide_init =
if Float
scale_abs forall a. Eq a => a -> a -> Bool
== Float
0.0 then
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
else
Float
1.0 forall a. Fractional a => a -> a -> a
/ (Float
0.5 forall a. Num a => a -> a -> a
* Float
scale_abs)
heights :: [Integer]
heights =
if Float
scale forall a. Ord a => a -> a -> Bool
< Float
0.0 then
forall a. [a] -> [a]
Data.List.reverse (forall a. Int -> [a] -> [a]
take Int
n [Integer]
heights_noflip)
else
[Integer]
heights_noflip
ys :: [Position]
ys = [forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
k [Integer]
heights | Int
k <- [Int
0..Int
n forall a. Num a => a -> a -> a
- Int
1]]
rects :: [Rectangle]
rects = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Rectangle -> (Integer, Position) -> Rectangle
mkRect Rectangle
rect)) [Integer]
heights [Position]
ys
mkRect :: XMonad.Rectangle
-> (Integer,XMonad.Position)
-> XMonad.Rectangle
mkRect :: Rectangle -> (Integer, Position) -> Rectangle
mkRect (XMonad.Rectangle Position
xs Position
ys Dimension
ws Dimension
_) (Integer
h, Position
y) =
Position -> Position -> Dimension -> Dimension -> Rectangle
XMonad.Rectangle Position
xs (Position
ys forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y) Dimension
ws (forall a. Num a => Integer -> a
fromInteger Integer
h)