{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.DecorationEx.TabbedGeometry
-- Description :  Tab-based window decoration geometry
-- Copyright   :  (c) 2007 Andrea Rossato, 2023 Ilya Portnov
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  portnov84@rambler.ru
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module defines window decoration geometry based on tabs.
-- The tabs can follow horizontally and be placed above or below windows;
-- in such case, tabs can occupy full width of the window or be aligned to
-- left or right. Or tabs can go vertically near left or right side of
-- the window.
-----------------------------------------------------------------------------

module XMonad.Layout.DecorationEx.TabbedGeometry (
    textTabbed,
    TabbedGeometry (..),
    HorizontalTabPlacement (..),
    VerticalTabPlacement (..),
    HorizontalTabWidth (..),
    HorizontalTabsAlignment (..),
    SingleTabMode (..)
  ) where 

import XMonad
import qualified XMonad.StackSet as W
import XMonad.Prelude
import XMonad.Layout.Decoration (ModifiedLayout, Shrinker (..))

import XMonad.Layout.DecorationEx.LayoutModifier
import XMonad.Layout.DecorationEx.Common
import XMonad.Layout.DecorationEx.Geometry
import XMonad.Layout.DecorationEx.Widgets
import XMonad.Layout.DecorationEx.TextEngine

-- | Placement of tabs when they go horizontally:
-- should they be placed above or below the window.
data HorizontalTabPlacement = Top | Bottom
  deriving (HorizontalTabPlacement -> HorizontalTabPlacement -> Bool
(HorizontalTabPlacement -> HorizontalTabPlacement -> Bool)
-> (HorizontalTabPlacement -> HorizontalTabPlacement -> Bool)
-> Eq HorizontalTabPlacement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HorizontalTabPlacement -> HorizontalTabPlacement -> Bool
== :: HorizontalTabPlacement -> HorizontalTabPlacement -> Bool
$c/= :: HorizontalTabPlacement -> HorizontalTabPlacement -> Bool
/= :: HorizontalTabPlacement -> HorizontalTabPlacement -> Bool
Eq, ReadPrec [HorizontalTabPlacement]
ReadPrec HorizontalTabPlacement
Int -> ReadS HorizontalTabPlacement
ReadS [HorizontalTabPlacement]
(Int -> ReadS HorizontalTabPlacement)
-> ReadS [HorizontalTabPlacement]
-> ReadPrec HorizontalTabPlacement
-> ReadPrec [HorizontalTabPlacement]
-> Read HorizontalTabPlacement
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS HorizontalTabPlacement
readsPrec :: Int -> ReadS HorizontalTabPlacement
$creadList :: ReadS [HorizontalTabPlacement]
readList :: ReadS [HorizontalTabPlacement]
$creadPrec :: ReadPrec HorizontalTabPlacement
readPrec :: ReadPrec HorizontalTabPlacement
$creadListPrec :: ReadPrec [HorizontalTabPlacement]
readListPrec :: ReadPrec [HorizontalTabPlacement]
Read, Int -> HorizontalTabPlacement -> ShowS
[HorizontalTabPlacement] -> ShowS
HorizontalTabPlacement -> String
(Int -> HorizontalTabPlacement -> ShowS)
-> (HorizontalTabPlacement -> String)
-> ([HorizontalTabPlacement] -> ShowS)
-> Show HorizontalTabPlacement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HorizontalTabPlacement -> ShowS
showsPrec :: Int -> HorizontalTabPlacement -> ShowS
$cshow :: HorizontalTabPlacement -> String
show :: HorizontalTabPlacement -> String
$cshowList :: [HorizontalTabPlacement] -> ShowS
showList :: [HorizontalTabPlacement] -> ShowS
Show)

-- | Placement of tabs when they go vertically:
-- should they appear at left or at right side of the window.
data VerticalTabPlacement = TabsAtLeft | TabsAtRight
  deriving (VerticalTabPlacement -> VerticalTabPlacement -> Bool
(VerticalTabPlacement -> VerticalTabPlacement -> Bool)
-> (VerticalTabPlacement -> VerticalTabPlacement -> Bool)
-> Eq VerticalTabPlacement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerticalTabPlacement -> VerticalTabPlacement -> Bool
== :: VerticalTabPlacement -> VerticalTabPlacement -> Bool
$c/= :: VerticalTabPlacement -> VerticalTabPlacement -> Bool
/= :: VerticalTabPlacement -> VerticalTabPlacement -> Bool
Eq, ReadPrec [VerticalTabPlacement]
ReadPrec VerticalTabPlacement
Int -> ReadS VerticalTabPlacement
ReadS [VerticalTabPlacement]
(Int -> ReadS VerticalTabPlacement)
-> ReadS [VerticalTabPlacement]
-> ReadPrec VerticalTabPlacement
-> ReadPrec [VerticalTabPlacement]
-> Read VerticalTabPlacement
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS VerticalTabPlacement
readsPrec :: Int -> ReadS VerticalTabPlacement
$creadList :: ReadS [VerticalTabPlacement]
readList :: ReadS [VerticalTabPlacement]
$creadPrec :: ReadPrec VerticalTabPlacement
readPrec :: ReadPrec VerticalTabPlacement
$creadListPrec :: ReadPrec [VerticalTabPlacement]
readListPrec :: ReadPrec [VerticalTabPlacement]
Read, Int -> VerticalTabPlacement -> ShowS
[VerticalTabPlacement] -> ShowS
VerticalTabPlacement -> String
(Int -> VerticalTabPlacement -> ShowS)
-> (VerticalTabPlacement -> String)
-> ([VerticalTabPlacement] -> ShowS)
-> Show VerticalTabPlacement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerticalTabPlacement -> ShowS
showsPrec :: Int -> VerticalTabPlacement -> ShowS
$cshow :: VerticalTabPlacement -> String
show :: VerticalTabPlacement -> String
$cshowList :: [VerticalTabPlacement] -> ShowS
showList :: [VerticalTabPlacement] -> ShowS
Show)

-- | Width of tabs when they go horizontally.
data HorizontalTabWidth =
      AutoWidth             -- ^ Define the width automatically by evenly dividing windows' width
    | FixedWidth !Dimension -- ^ Use fixed width of the tab
  deriving (HorizontalTabWidth -> HorizontalTabWidth -> Bool
(HorizontalTabWidth -> HorizontalTabWidth -> Bool)
-> (HorizontalTabWidth -> HorizontalTabWidth -> Bool)
-> Eq HorizontalTabWidth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HorizontalTabWidth -> HorizontalTabWidth -> Bool
== :: HorizontalTabWidth -> HorizontalTabWidth -> Bool
$c/= :: HorizontalTabWidth -> HorizontalTabWidth -> Bool
/= :: HorizontalTabWidth -> HorizontalTabWidth -> Bool
Eq, ReadPrec [HorizontalTabWidth]
ReadPrec HorizontalTabWidth
Int -> ReadS HorizontalTabWidth
ReadS [HorizontalTabWidth]
(Int -> ReadS HorizontalTabWidth)
-> ReadS [HorizontalTabWidth]
-> ReadPrec HorizontalTabWidth
-> ReadPrec [HorizontalTabWidth]
-> Read HorizontalTabWidth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS HorizontalTabWidth
readsPrec :: Int -> ReadS HorizontalTabWidth
$creadList :: ReadS [HorizontalTabWidth]
readList :: ReadS [HorizontalTabWidth]
$creadPrec :: ReadPrec HorizontalTabWidth
readPrec :: ReadPrec HorizontalTabWidth
$creadListPrec :: ReadPrec [HorizontalTabWidth]
readListPrec :: ReadPrec [HorizontalTabWidth]
Read, Int -> HorizontalTabWidth -> ShowS
[HorizontalTabWidth] -> ShowS
HorizontalTabWidth -> String
(Int -> HorizontalTabWidth -> ShowS)
-> (HorizontalTabWidth -> String)
-> ([HorizontalTabWidth] -> ShowS)
-> Show HorizontalTabWidth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HorizontalTabWidth -> ShowS
showsPrec :: Int -> HorizontalTabWidth -> ShowS
$cshow :: HorizontalTabWidth -> String
show :: HorizontalTabWidth -> String
$cshowList :: [HorizontalTabWidth] -> ShowS
showList :: [HorizontalTabWidth] -> ShowS
Show)

-- | Alignment of tabs when they go horizontally.
data HorizontalTabsAlignment = AlignTabsLeft | AlignTabsCenter | AlignTabsRight
  deriving (HorizontalTabsAlignment -> HorizontalTabsAlignment -> Bool
(HorizontalTabsAlignment -> HorizontalTabsAlignment -> Bool)
-> (HorizontalTabsAlignment -> HorizontalTabsAlignment -> Bool)
-> Eq HorizontalTabsAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HorizontalTabsAlignment -> HorizontalTabsAlignment -> Bool
== :: HorizontalTabsAlignment -> HorizontalTabsAlignment -> Bool
$c/= :: HorizontalTabsAlignment -> HorizontalTabsAlignment -> Bool
/= :: HorizontalTabsAlignment -> HorizontalTabsAlignment -> Bool
Eq, ReadPrec [HorizontalTabsAlignment]
ReadPrec HorizontalTabsAlignment
Int -> ReadS HorizontalTabsAlignment
ReadS [HorizontalTabsAlignment]
(Int -> ReadS HorizontalTabsAlignment)
-> ReadS [HorizontalTabsAlignment]
-> ReadPrec HorizontalTabsAlignment
-> ReadPrec [HorizontalTabsAlignment]
-> Read HorizontalTabsAlignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS HorizontalTabsAlignment
readsPrec :: Int -> ReadS HorizontalTabsAlignment
$creadList :: ReadS [HorizontalTabsAlignment]
readList :: ReadS [HorizontalTabsAlignment]
$creadPrec :: ReadPrec HorizontalTabsAlignment
readPrec :: ReadPrec HorizontalTabsAlignment
$creadListPrec :: ReadPrec [HorizontalTabsAlignment]
readListPrec :: ReadPrec [HorizontalTabsAlignment]
Read, Int -> HorizontalTabsAlignment -> ShowS
[HorizontalTabsAlignment] -> ShowS
HorizontalTabsAlignment -> String
(Int -> HorizontalTabsAlignment -> ShowS)
-> (HorizontalTabsAlignment -> String)
-> ([HorizontalTabsAlignment] -> ShowS)
-> Show HorizontalTabsAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HorizontalTabsAlignment -> ShowS
showsPrec :: Int -> HorizontalTabsAlignment -> ShowS
$cshow :: HorizontalTabsAlignment -> String
show :: HorizontalTabsAlignment -> String
$cshowList :: [HorizontalTabsAlignment] -> ShowS
showList :: [HorizontalTabsAlignment] -> ShowS
Show)

-- | What to do if there is only one tab.
data SingleTabMode = ShowTab | HideTab
  deriving (SingleTabMode -> SingleTabMode -> Bool
(SingleTabMode -> SingleTabMode -> Bool)
-> (SingleTabMode -> SingleTabMode -> Bool) -> Eq SingleTabMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SingleTabMode -> SingleTabMode -> Bool
== :: SingleTabMode -> SingleTabMode -> Bool
$c/= :: SingleTabMode -> SingleTabMode -> Bool
/= :: SingleTabMode -> SingleTabMode -> Bool
Eq, ReadPrec [SingleTabMode]
ReadPrec SingleTabMode
Int -> ReadS SingleTabMode
ReadS [SingleTabMode]
(Int -> ReadS SingleTabMode)
-> ReadS [SingleTabMode]
-> ReadPrec SingleTabMode
-> ReadPrec [SingleTabMode]
-> Read SingleTabMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SingleTabMode
readsPrec :: Int -> ReadS SingleTabMode
$creadList :: ReadS [SingleTabMode]
readList :: ReadS [SingleTabMode]
$creadPrec :: ReadPrec SingleTabMode
readPrec :: ReadPrec SingleTabMode
$creadListPrec :: ReadPrec [SingleTabMode]
readListPrec :: ReadPrec [SingleTabMode]
Read, Int -> SingleTabMode -> ShowS
[SingleTabMode] -> ShowS
SingleTabMode -> String
(Int -> SingleTabMode -> ShowS)
-> (SingleTabMode -> String)
-> ([SingleTabMode] -> ShowS)
-> Show SingleTabMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SingleTabMode -> ShowS
showsPrec :: Int -> SingleTabMode -> ShowS
$cshow :: SingleTabMode -> String
show :: SingleTabMode -> String
$cshowList :: [SingleTabMode] -> ShowS
showList :: [SingleTabMode] -> ShowS
Show)

data TabbedGeometry a =
      HorizontalTabs {
          forall a. TabbedGeometry a -> SingleTabMode
showIfSingleWindow :: !SingleTabMode      -- ^ What to do if there is only one tab
        , forall a. TabbedGeometry a -> HorizontalTabPlacement
hTabPlacement :: !HorizontalTabPlacement  -- ^ Where to place horizontal tabs
        , forall a. TabbedGeometry a -> HorizontalTabsAlignment
hTabAlignment :: !HorizontalTabsAlignment -- ^ How to align horizontal tabs (makes sense with fixed width of tabs).
        , forall a. TabbedGeometry a -> HorizontalTabWidth
hTabWidth :: !HorizontalTabWidth          -- ^ Width of horizontal tabs
        , forall a. TabbedGeometry a -> Dimension
hTabHeight :: !Dimension                  -- ^ Height of horizontal tabs
      }
    | VerticalTabs {
          showIfSingleWindow :: !SingleTabMode      -- ^ What to do if there is only one tab
        , forall a. TabbedGeometry a -> VerticalTabPlacement
vTabPlacement :: !VerticalTabPlacement    -- ^ Where to place vertical tabs
        , forall a. TabbedGeometry a -> Dimension
vTabWidth :: !Dimension                   -- ^ Width of vertical tabs
        , forall a. TabbedGeometry a -> Dimension
vTabHeight :: !Dimension                  -- ^ Height of vertical tabs
      }
  deriving (Int -> TabbedGeometry a -> ShowS
[TabbedGeometry a] -> ShowS
TabbedGeometry a -> String
(Int -> TabbedGeometry a -> ShowS)
-> (TabbedGeometry a -> String)
-> ([TabbedGeometry a] -> ShowS)
-> Show (TabbedGeometry a)
forall a. Int -> TabbedGeometry a -> ShowS
forall a. [TabbedGeometry a] -> ShowS
forall a. TabbedGeometry a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> TabbedGeometry a -> ShowS
showsPrec :: Int -> TabbedGeometry a -> ShowS
$cshow :: forall a. TabbedGeometry a -> String
show :: TabbedGeometry a -> String
$cshowList :: forall a. [TabbedGeometry a] -> ShowS
showList :: [TabbedGeometry a] -> ShowS
Show, ReadPrec [TabbedGeometry a]
ReadPrec (TabbedGeometry a)
Int -> ReadS (TabbedGeometry a)
ReadS [TabbedGeometry a]
(Int -> ReadS (TabbedGeometry a))
-> ReadS [TabbedGeometry a]
-> ReadPrec (TabbedGeometry a)
-> ReadPrec [TabbedGeometry a]
-> Read (TabbedGeometry a)
forall a. ReadPrec [TabbedGeometry a]
forall a. ReadPrec (TabbedGeometry a)
forall a. Int -> ReadS (TabbedGeometry a)
forall a. ReadS [TabbedGeometry a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Int -> ReadS (TabbedGeometry a)
readsPrec :: Int -> ReadS (TabbedGeometry a)
$creadList :: forall a. ReadS [TabbedGeometry a]
readList :: ReadS [TabbedGeometry a]
$creadPrec :: forall a. ReadPrec (TabbedGeometry a)
readPrec :: ReadPrec (TabbedGeometry a)
$creadListPrec :: forall a. ReadPrec [TabbedGeometry a]
readListPrec :: ReadPrec [TabbedGeometry a]
Read)

instance Default (TabbedGeometry a) where
  def :: TabbedGeometry a
def = SingleTabMode
-> HorizontalTabPlacement
-> HorizontalTabsAlignment
-> HorizontalTabWidth
-> Dimension
-> TabbedGeometry a
forall a.
SingleTabMode
-> HorizontalTabPlacement
-> HorizontalTabsAlignment
-> HorizontalTabWidth
-> Dimension
-> TabbedGeometry a
HorizontalTabs SingleTabMode
ShowTab HorizontalTabPlacement
Top HorizontalTabsAlignment
AlignTabsLeft HorizontalTabWidth
AutoWidth Dimension
20 

instance DecorationGeometry TabbedGeometry Window where

  describeGeometry :: TabbedGeometry Window -> String
describeGeometry TabbedGeometry Window
_ = String
"Tabbed"

  pureDecoration :: TabbedGeometry Window
-> Rectangle
-> Stack Window
-> [(Window, Rectangle)]
-> (Window, Rectangle)
-> Maybe Rectangle
pureDecoration TabbedGeometry Window
tabs Rectangle
_ Stack Window
stack [(Window, Rectangle)]
wrs (Window
window, Rectangle
windowRect) =
    let Rectangle Position
windowX Position
windowY Dimension
windowWidth Dimension
windowHeight = Rectangle
windowRect
        -- windows that are mapped onto the same rectangle as current one are considered to
        -- be in one tabs group
        tabbedWindows :: [Window]
tabbedWindows = (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Window, Rectangle) -> Window)
-> [(Window, Rectangle)] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst (((Window, Rectangle) -> Bool)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Rectangle -> Rectangle -> Bool
forall a. Eq a => a -> a -> Bool
==Rectangle
windowRect) (Rectangle -> Bool)
-> ((Window, Rectangle) -> Rectangle)
-> (Window, Rectangle)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd) [(Window, Rectangle)]
wrs)) (Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate Stack Window
stack)
        mbWindowIndex :: Maybe Int
mbWindowIndex = Window
window Window -> [Window] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [Window]
tabbedWindows
        numWindows :: Int
numWindows = [Window] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
tabbedWindows
    in  if Int
numWindows Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
|| (TabbedGeometry Window -> SingleTabMode
forall a. TabbedGeometry a -> SingleTabMode
showIfSingleWindow TabbedGeometry Window
tabs SingleTabMode -> SingleTabMode -> Bool
forall a. Eq a => a -> a -> Bool
== SingleTabMode
ShowTab Bool -> Bool -> Bool
&& Int
numWindows Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
          then
            case TabbedGeometry Window
tabs of
              HorizontalTabs {Dimension
SingleTabMode
HorizontalTabsAlignment
HorizontalTabWidth
HorizontalTabPlacement
showIfSingleWindow :: forall a. TabbedGeometry a -> SingleTabMode
hTabPlacement :: forall a. TabbedGeometry a -> HorizontalTabPlacement
hTabAlignment :: forall a. TabbedGeometry a -> HorizontalTabsAlignment
hTabWidth :: forall a. TabbedGeometry a -> HorizontalTabWidth
hTabHeight :: forall a. TabbedGeometry a -> Dimension
showIfSingleWindow :: SingleTabMode
hTabPlacement :: HorizontalTabPlacement
hTabAlignment :: HorizontalTabsAlignment
hTabWidth :: HorizontalTabWidth
hTabHeight :: Dimension
..} ->
                  Rectangle -> Maybe Rectangle
forall a. a -> Maybe a
Just (Rectangle -> Maybe Rectangle) -> Rectangle -> Maybe Rectangle
forall a b. (a -> b) -> a -> b
$ case HorizontalTabPlacement
hTabPlacement of
                            HorizontalTabPlacement
Top    -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
decoX Position
windowY Dimension
effectiveTabWidth Dimension
hTabHeight
                            HorizontalTabPlacement
Bottom -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
decoX (Position
windowY Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Dimension
windowHeight Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
hTabHeight)) Dimension
effectiveTabWidth Dimension
hTabHeight
                where
                  decoX :: Position
decoX = Position -> (Int -> Position) -> Maybe Int -> Position
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Position
windowX Int -> Position
tabX Maybe Int
mbWindowIndex

                  -- If there are too many windows or configured tab width
                  -- is too big, then we have to switch to 'auto' mode.
                  hTabWidth' :: HorizontalTabWidth
hTabWidth' =
                    case HorizontalTabWidth
hTabWidth of
                      HorizontalTabWidth
AutoWidth -> HorizontalTabWidth
AutoWidth
                      FixedWidth Dimension
tabWidth
                        | Dimension
tabWidth Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
numWindows Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
> Dimension
windowWidth -> HorizontalTabWidth
AutoWidth
                        | Bool
otherwise -> Dimension -> HorizontalTabWidth
FixedWidth Dimension
tabWidth

                  effectiveTabWidth :: Dimension
effectiveTabWidth =
                    case HorizontalTabWidth
hTabWidth' of
                      HorizontalTabWidth
AutoWidth -> Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (Position -> Dimension) -> Position -> Dimension
forall a b. (a -> b) -> a -> b
$ Position -> (Int -> Position) -> Maybe Int -> Position
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Position
windowX (\Int
i -> Int -> Position
tabX (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
tabX Int
i) Maybe Int
mbWindowIndex
                      FixedWidth Dimension
tabWidth -> Dimension
tabWidth

                  allTabsWidth :: Position
allTabsWidth =
                    case HorizontalTabWidth
hTabWidth' of
                      HorizontalTabWidth
AutoWidth -> Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
windowWidth
                      FixedWidth Dimension
_ -> Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Dimension -> Position) -> Dimension -> Position
forall a b. (a -> b) -> a -> b
$ Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
min Dimension
windowWidth (Dimension -> Dimension) -> Dimension -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension
effectiveTabWidth Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
max Dimension
1 (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
numWindows)

                  tabsStartX :: Position
tabsStartX =
                    case HorizontalTabsAlignment
hTabAlignment of
                      HorizontalTabsAlignment
AlignTabsLeft -> Position
windowX
                      HorizontalTabsAlignment
AlignTabsRight -> Position
windowX Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
windowWidth Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
allTabsWidth
                      HorizontalTabsAlignment
AlignTabsCenter -> Position
windowX Position -> Position -> Position
forall a. Num a => a -> a -> a
+ (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
windowWidth Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
allTabsWidth) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2

                  -- X coordinate of i'th window in horizontal tabs layout
                  tabX :: Int -> Position
tabX Int
i = Position
tabsStartX Position -> Position -> Position
forall a. Num a => a -> a -> a
+
                        case HorizontalTabWidth
hTabWidth' of
                          HorizontalTabWidth
AutoWidth -> Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi ((Dimension
windowWidth Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
i) Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
max Dimension
1 (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
numWindows))
                          FixedWidth Dimension
_ -> Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
effectiveTabWidth Position -> Position -> Position
forall a. Num a => a -> a -> a
* Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
i

              VerticalTabs {Dimension
SingleTabMode
VerticalTabPlacement
showIfSingleWindow :: forall a. TabbedGeometry a -> SingleTabMode
vTabPlacement :: forall a. TabbedGeometry a -> VerticalTabPlacement
vTabWidth :: forall a. TabbedGeometry a -> Dimension
vTabHeight :: forall a. TabbedGeometry a -> Dimension
showIfSingleWindow :: SingleTabMode
vTabPlacement :: VerticalTabPlacement
vTabWidth :: Dimension
vTabHeight :: Dimension
..} ->
                  Rectangle -> Maybe Rectangle
forall a. a -> Maybe a
Just (Rectangle -> Maybe Rectangle) -> Rectangle -> Maybe Rectangle
forall a b. (a -> b) -> a -> b
$ case VerticalTabPlacement
vTabPlacement of
                            VerticalTabPlacement
TabsAtLeft  -> Position -> Rectangle
fixHeightTab Position
windowX
                            VerticalTabPlacement
TabsAtRight -> Position -> Rectangle
fixHeightTab (Position
windowX Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Dimension
windowWidth Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
vTabWidth))
                where
                  fixHeightLoc :: Int -> Position
fixHeightLoc Int
i = Position
windowY Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
vTabHeight Position -> Position -> Position
forall a. Num a => a -> a -> a
* Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
i
                  fixHeightTab :: Position -> Rectangle
fixHeightTab Position
x = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x
                        (Position -> (Int -> Position) -> Maybe Int -> Position
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Position
windowY Int -> Position
fixHeightLoc Maybe Int
mbWindowIndex) Dimension
vTabWidth Dimension
vTabHeight
          else Maybe Rectangle
forall a. Maybe a
Nothing

  shrinkWindow :: TabbedGeometry Window -> Rectangle -> Rectangle -> Rectangle
shrinkWindow TabbedGeometry Window
tabs (Rectangle Position
_ Position
_ Dimension
dw Dimension
dh) (Rectangle Position
x Position
y Dimension
w Dimension
h) =
    case TabbedGeometry Window
tabs of
      HorizontalTabs {Dimension
SingleTabMode
HorizontalTabsAlignment
HorizontalTabWidth
HorizontalTabPlacement
showIfSingleWindow :: forall a. TabbedGeometry a -> SingleTabMode
hTabPlacement :: forall a. TabbedGeometry a -> HorizontalTabPlacement
hTabAlignment :: forall a. TabbedGeometry a -> HorizontalTabsAlignment
hTabWidth :: forall a. TabbedGeometry a -> HorizontalTabWidth
hTabHeight :: forall a. TabbedGeometry a -> Dimension
showIfSingleWindow :: SingleTabMode
hTabPlacement :: HorizontalTabPlacement
hTabAlignment :: HorizontalTabsAlignment
hTabWidth :: HorizontalTabWidth
hTabHeight :: Dimension
..} ->
        case HorizontalTabPlacement
hTabPlacement of
            HorizontalTabPlacement
Top -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
dh) Dimension
w (Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
dh)
            HorizontalTabPlacement
Bottom -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w (Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
dh)
      VerticalTabs {Dimension
SingleTabMode
VerticalTabPlacement
showIfSingleWindow :: forall a. TabbedGeometry a -> SingleTabMode
vTabPlacement :: forall a. TabbedGeometry a -> VerticalTabPlacement
vTabWidth :: forall a. TabbedGeometry a -> Dimension
vTabHeight :: forall a. TabbedGeometry a -> Dimension
showIfSingleWindow :: SingleTabMode
vTabPlacement :: VerticalTabPlacement
vTabWidth :: Dimension
vTabHeight :: Dimension
..} ->
        case VerticalTabPlacement
vTabPlacement of
            VerticalTabPlacement
TabsAtLeft  -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
dw) Position
y (Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
dw) Dimension
h
            VerticalTabPlacement
TabsAtRight -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
dw) Dimension
h

-- | Add tabbed decorations (with default settings) with text-based widgets to a layout.
textTabbed :: (Shrinker shrinker)
           => shrinker               -- ^ Strings shrinker, e.g. @shrinkText@
           -> ThemeEx StandardWidget -- ^ Decoration theme
           -> l Window               -- ^ Layout to be decorated
           -> ModifiedLayout (DecorationEx TextDecoration StandardWidget TabbedGeometry shrinker) l Window
textTabbed :: forall shrinker (l :: * -> *).
Shrinker shrinker =>
shrinker
-> ThemeEx StandardWidget
-> l Window
-> ModifiedLayout
     (DecorationEx
        TextDecoration StandardWidget TabbedGeometry shrinker)
     l
     Window
textTabbed shrinker
shrinker ThemeEx StandardWidget
theme = shrinker
-> Theme TextDecoration StandardWidget
-> TextDecoration StandardWidget Window
-> TabbedGeometry Window
-> l Window
-> ModifiedLayout
     (DecorationEx
        TextDecoration StandardWidget TabbedGeometry shrinker)
     l
     Window
forall (engine :: * -> * -> *) widget a (geom :: * -> *) shrinker
       (l :: * -> *).
(DecorationEngine engine widget a, DecorationGeometry geom a,
 Shrinker shrinker) =>
shrinker
-> Theme engine widget
-> engine widget a
-> geom a
-> l a
-> ModifiedLayout (DecorationEx engine widget geom shrinker) l a
decorationEx shrinker
shrinker ThemeEx StandardWidget
Theme TextDecoration StandardWidget
theme TextDecoration StandardWidget Window
forall widget a. TextDecoration widget a
TextDecoration TabbedGeometry Window
forall a. Default a => a
def