{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
module XMonad.Layout.Tabbed
(
simpleTabbed, tabbed, addTabs
, simpleTabbedAlways, tabbedAlways, addTabsAlways
, simpleTabbedBottom, tabbedBottom, addTabsBottom
, simpleTabbedLeft, tabbedLeft, addTabsLeft
, simpleTabbedRight, tabbedRight, addTabsRight
, simpleTabbedBottomAlways, tabbedBottomAlways, addTabsBottomAlways
, simpleTabbedLeftAlways, tabbedLeftAlways, addTabsLeftAlways
, simpleTabbedRightAlways, tabbedRightAlways, addTabsRightAlways
, Theme (..)
, def
, TabbedDecoration (..)
, shrinkText, CustomShrink(CustomShrink)
, Shrinker(..)
, TabbarShown, Direction2D(..)
) where
import XMonad.Prelude
import XMonad
import qualified XMonad.StackSet as S
import XMonad.Layout.Decoration
import XMonad.Layout.Simplest ( Simplest(Simplest) )
import XMonad.Util.Types (Direction2D(..))
simpleTabbed :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbed :: ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbed = forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbed DefaultShrinker
shrinkText forall a. Default a => a
def
simpleTabbedAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedAlways :: ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedAlways = forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedAlways DefaultShrinker
shrinkText forall a. Default a => a
def
simpleTabbedBottom :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedBottom :: ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedBottom = forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedBottom DefaultShrinker
shrinkText forall a. Default a => a
def
simpleTabbedBottomAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedBottomAlways :: ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedBottomAlways = forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedBottomAlways DefaultShrinker
shrinkText forall a. Default a => a
def
simpleTabbedLeft, simpleTabbedRight :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker)
Simplest Window
simpleTabbedLeft :: ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedLeft = forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedLeft DefaultShrinker
shrinkText forall a. Default a => a
def
simpleTabbedRight :: ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedRight = forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedRight DefaultShrinker
shrinkText forall a. Default a => a
def
simpleTabbedLeftAlways, simpleTabbedRightAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker)
Simplest Window
simpleTabbedLeftAlways :: ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedLeftAlways = forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedLeftAlways DefaultShrinker
shrinkText forall a. Default a => a
def
simpleTabbedRightAlways :: ModifiedLayout
(Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedRightAlways = forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedRightAlways DefaultShrinker
shrinkText forall a. Default a => a
def
tabbed :: (Eq a, Shrinker s) => s -> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbed :: forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbed s
s Theme
c = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabs s
s Theme
c forall a. Simplest a
Simplest
tabbedAlways :: (Eq a, Shrinker s) => s -> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedAlways :: forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedAlways s
s Theme
c = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsAlways s
s Theme
c forall a. Simplest a
Simplest
tabbedBottom :: (Eq a, Shrinker s) => s -> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedBottom :: forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedBottom s
s Theme
c = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsBottom s
s Theme
c forall a. Simplest a
Simplest
tabbedBottomAlways :: (Eq a, Shrinker s) => s -> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedBottomAlways :: forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedBottomAlways s
s Theme
c = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsBottomAlways s
s Theme
c forall a. Simplest a
Simplest
tabbedLeft, tabbedRight :: (Eq a, Shrinker s) => s -> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedLeft :: forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedLeft s
s Theme
c = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsLeft s
s Theme
c forall a. Simplest a
Simplest
tabbedRight :: forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedRight s
s Theme
c = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsRight s
s Theme
c forall a. Simplest a
Simplest
tabbedLeftAlways, tabbedRightAlways :: (Eq a, Shrinker s) => s -> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedLeftAlways :: forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedLeftAlways s
s Theme
c = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsLeftAlways s
s Theme
c forall a. Simplest a
Simplest
tabbedRightAlways :: forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedRightAlways s
s Theme
c = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsRightAlways s
s Theme
c forall a. Simplest a
Simplest
addTabs :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabs :: forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabs = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
TabbarShown
-> Direction2D
-> s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
createTabs TabbarShown
WhenPlural Direction2D
U
addTabsAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsAlways :: forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsAlways = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
TabbarShown
-> Direction2D
-> s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
createTabs TabbarShown
Always Direction2D
U
addTabsBottom :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsBottom :: forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsBottom = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
TabbarShown
-> Direction2D
-> s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
createTabs TabbarShown
WhenPlural Direction2D
D
addTabsBottomAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsBottomAlways :: forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsBottomAlways = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
TabbarShown
-> Direction2D
-> s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
createTabs TabbarShown
Always Direction2D
D
addTabsRight, addTabsLeft :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsRight :: forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsRight = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
TabbarShown
-> Direction2D
-> s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
createTabs TabbarShown
WhenPlural Direction2D
R
addTabsLeft :: forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsLeft = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
TabbarShown
-> Direction2D
-> s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
createTabs TabbarShown
WhenPlural Direction2D
L
addTabsRightAlways, addTabsLeftAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsRightAlways :: forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsRightAlways = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
TabbarShown
-> Direction2D
-> s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
createTabs TabbarShown
Always Direction2D
R
addTabsLeftAlways :: forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsLeftAlways = forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
TabbarShown
-> Direction2D
-> s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
createTabs TabbarShown
Always Direction2D
L
createTabs ::(Eq a, LayoutClass l a, Shrinker s) => TabbarShown -> Direction2D -> s
-> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a
createTabs :: forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
TabbarShown
-> Direction2D
-> s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
createTabs TabbarShown
sh Direction2D
loc s
tx Theme
th = forall (ds :: * -> *) a s (l :: * -> *).
(DecorationStyle ds a, Shrinker s) =>
s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
decoration s
tx Theme
th (forall a. Direction2D -> TabbarShown -> TabbedDecoration a
Tabbed Direction2D
loc TabbarShown
sh)
data TabbarShown = Always | WhenPlural deriving (ReadPrec [TabbarShown]
ReadPrec TabbarShown
Int -> ReadS TabbarShown
ReadS [TabbarShown]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TabbarShown]
$creadListPrec :: ReadPrec [TabbarShown]
readPrec :: ReadPrec TabbarShown
$creadPrec :: ReadPrec TabbarShown
readList :: ReadS [TabbarShown]
$creadList :: ReadS [TabbarShown]
readsPrec :: Int -> ReadS TabbarShown
$creadsPrec :: Int -> ReadS TabbarShown
Read, Int -> TabbarShown -> ShowS
[TabbarShown] -> ShowS
TabbarShown -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TabbarShown] -> ShowS
$cshowList :: [TabbarShown] -> ShowS
show :: TabbarShown -> String
$cshow :: TabbarShown -> String
showsPrec :: Int -> TabbarShown -> ShowS
$cshowsPrec :: Int -> TabbarShown -> ShowS
Show, TabbarShown -> TabbarShown -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TabbarShown -> TabbarShown -> Bool
$c/= :: TabbarShown -> TabbarShown -> Bool
== :: TabbarShown -> TabbarShown -> Bool
$c== :: TabbarShown -> TabbarShown -> Bool
Eq)
data TabbedDecoration a = Tabbed Direction2D TabbarShown deriving (ReadPrec [TabbedDecoration a]
ReadPrec (TabbedDecoration a)
ReadS [TabbedDecoration a]
forall a. ReadPrec [TabbedDecoration a]
forall a. ReadPrec (TabbedDecoration a)
forall a. Int -> ReadS (TabbedDecoration a)
forall a. ReadS [TabbedDecoration a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TabbedDecoration a]
$creadListPrec :: forall a. ReadPrec [TabbedDecoration a]
readPrec :: ReadPrec (TabbedDecoration a)
$creadPrec :: forall a. ReadPrec (TabbedDecoration a)
readList :: ReadS [TabbedDecoration a]
$creadList :: forall a. ReadS [TabbedDecoration a]
readsPrec :: Int -> ReadS (TabbedDecoration a)
$creadsPrec :: forall a. Int -> ReadS (TabbedDecoration a)
Read, Int -> TabbedDecoration a -> ShowS
forall a. Int -> TabbedDecoration a -> ShowS
forall a. [TabbedDecoration a] -> ShowS
forall a. TabbedDecoration a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TabbedDecoration a] -> ShowS
$cshowList :: forall a. [TabbedDecoration a] -> ShowS
show :: TabbedDecoration a -> String
$cshow :: forall a. TabbedDecoration a -> String
showsPrec :: Int -> TabbedDecoration a -> ShowS
$cshowsPrec :: forall a. Int -> TabbedDecoration a -> ShowS
Show)
instance Eq a => DecorationStyle TabbedDecoration a where
describeDeco :: TabbedDecoration a -> String
describeDeco (Tabbed Direction2D
U TabbarShown
_ ) = String
"Tabbed"
describeDeco (Tabbed Direction2D
D TabbarShown
_ ) = String
"Tabbed Bottom"
describeDeco (Tabbed Direction2D
L TabbarShown
_ ) = String
"Tabbed Left"
describeDeco (Tabbed Direction2D
R TabbarShown
_ ) = String
"Tabbed Right"
decorationEventHook :: TabbedDecoration a -> DecorationState -> Event -> X ()
decorationEventHook TabbedDecoration a
_ DecorationState
ds ButtonEvent { ev_window :: Event -> Window
ev_window = Window
ew
, ev_event_type :: Event -> Dimension
ev_event_type = Dimension
et
, ev_button :: Event -> Dimension
ev_button = Dimension
eb }
| Dimension
et forall a. Eq a => a -> a -> Bool
== Dimension
buttonPress
, Just ((Window
w,Rectangle
_),(Window, Maybe Rectangle)
_) <- Window
-> DecorationState
-> Maybe ((Window, Rectangle), (Window, Maybe Rectangle))
findWindowByDecoration Window
ew DecorationState
ds =
if Dimension
eb forall a. Eq a => a -> a -> Bool
== Dimension
button2
then Window -> X ()
killWindow Window
w
else Window -> X ()
focus Window
w
decorationEventHook TabbedDecoration a
_ DecorationState
_ Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
pureDecoration :: TabbedDecoration a
-> Dimension
-> Dimension
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
-> (a, Rectangle)
-> Maybe Rectangle
pureDecoration (Tabbed Direction2D
lc TabbarShown
sh) Dimension
wt Dimension
ht Rectangle
_ Stack a
s [(a, Rectangle)]
wrs (a
w,r :: Rectangle
r@(Rectangle Position
x Position
y Dimension
wh Dimension
hh))
= if (TabbarShown
sh forall a. Eq a => a -> a -> Bool
== TabbarShown
Always Bool -> Bool -> Bool
&& Int
numWindows forall a. Ord a => a -> a -> Bool
> Int
0) Bool -> Bool -> Bool
|| Int
numWindows forall a. Ord a => a -> a -> Bool
> Int
1
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Direction2D
lc of
Direction2D
U -> Rectangle
upperTab
Direction2D
D -> Rectangle
lowerTab
Direction2D
L -> Rectangle
leftTab
Direction2D
R -> Rectangle
rightTab
else forall a. Maybe a
Nothing
where ws :: [a]
ws = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==Rectangle
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(a, Rectangle)]
wrs)) (forall a. Stack a -> [a]
S.integrate Stack a
s)
loc :: a -> a -> a -> a
loc a
k a
h a
i = a
k forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi ((a
h forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi a
i) forall a. Integral a => a -> a -> a
`div` forall a. Ord a => a -> a -> a
max a
1 (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws))
esize :: a -> a -> b
esize a
k a
h = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
k (\Int
i -> forall {a} {a} {a}.
(Integral a, Integral a, Num a) =>
a -> a -> a -> a
loc a
k a
h (Int
iforall a. Num a => a -> a -> a
+Int
1) forall a. Num a => a -> a -> a
- forall {a} {a} {a}.
(Integral a, Integral a, Num a) =>
a -> a -> a -> a
loc a
k a
h Int
i) forall a b. (a -> b) -> a -> b
$ a
w forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [a]
ws
wid :: Dimension
wid = forall {a} {a} {b}. (Integral a, Integral a, Num b) => a -> a -> b
esize Position
x Dimension
wh
n :: b -> a -> b
n b
k a
h = forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
k (forall {a} {a} {a}.
(Integral a, Integral a, Num a) =>
a -> a -> a -> a
loc b
k a
h) forall a b. (a -> b) -> a -> b
$ a
w forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [a]
ws
nx :: Position
nx = forall {a} {b}. (Integral a, Num b) => b -> a -> b
n Position
x Dimension
wh
upperTab :: Rectangle
upperTab = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
nx Position
y Dimension
wid (forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht)
lowerTab :: Rectangle
lowerTab = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
nx (Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Dimension
hh forall a. Num a => a -> a -> a
- Dimension
ht)) Dimension
wid (forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht)
fixHeightLoc :: a -> Position
fixHeightLoc a
i = Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi a
i
fixHeightTab :: Position -> Rectangle
fixHeightTab Position
k = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
k
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe Position
y forall {a}. Integral a => a -> Position
fixHeightLoc
forall a b. (a -> b) -> a -> b
$ a
w forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [a]
ws) (forall a b. (Integral a, Num b) => a -> b
fi Dimension
wt) (forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht)
rightTab :: Rectangle
rightTab = Position -> Rectangle
fixHeightTab (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Dimension
wh forall a. Num a => a -> a -> a
- Dimension
wt))
leftTab :: Rectangle
leftTab = Position -> Rectangle
fixHeightTab Position
x
numWindows :: Int
numWindows = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws
shrink :: TabbedDecoration a -> Rectangle -> Rectangle -> Rectangle
shrink (Tabbed Direction2D
loc TabbarShown
_ ) (Rectangle Position
_ Position
_ Dimension
dw Dimension
dh) (Rectangle Position
x Position
y Dimension
w Dimension
h)
= case Direction2D
loc of
Direction2D
U -> 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)
Direction2D
D -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w (Dimension
h forall a. Num a => a -> a -> a
- Dimension
dh)
Direction2D
L -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
dw) Position
y (Dimension
w forall a. Num a => a -> a -> a
- Dimension
dw) Dimension
h
Direction2D
R -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w forall a. Num a => a -> a -> a
- Dimension
dw) Dimension
h