module Matterhorn.Draw.TabbedWindow
( drawTabbedWindow
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick
import Brick.Widgets.Border
import Brick.Widgets.Center
import Data.List ( intersperse )
import qualified Graphics.Vty as Vty
import Network.Mattermost.Types ( TeamId )
import Matterhorn.Draw.Util ( renderKeybindingHelp )
import Matterhorn.Types
import Matterhorn.Themes
import Matterhorn.Types.KeyEvents
drawTabbedWindow :: (Eq a, Show a)
=> TabbedWindow a
-> ChatState
-> Widget Name
drawTabbedWindow :: TabbedWindow a -> ChatState -> Widget Name
drawTabbedWindow TabbedWindow a
w ChatState
cs =
let cur :: TabbedWindowEntry a
cur = TabbedWindow a -> TabbedWindowEntry a
forall a. (Show a, Eq a) => TabbedWindow a -> TabbedWindowEntry a
getCurrentTabbedWindowEntry TabbedWindow a
w
tabBody :: Widget Name
tabBody = TabbedWindowEntry a -> a -> ChatState -> Widget Name
forall a. TabbedWindowEntry a -> a -> ChatState -> Widget Name
tweRender TabbedWindowEntry a
cur (TabbedWindow a -> a
forall a. TabbedWindow a -> a
twValue TabbedWindow a
w) ChatState
cs
title :: Widget Name
title = AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
clientEmphAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ TabbedWindowTemplate a -> a -> Widget Name
forall a. TabbedWindowTemplate a -> a -> Widget Name
twtTitle (TabbedWindow a -> TabbedWindowTemplate a
forall a. TabbedWindow a -> TabbedWindowTemplate a
twTemplate TabbedWindow a
w) (TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue TabbedWindowEntry a
cur)
tId :: TeamId
tId = ChatState
csChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
in Widget Name -> Widget Name
forall n. Widget n -> Widget n
centerLayer (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit (TabbedWindow a -> Int
forall a. TabbedWindow a -> Int
twWindowHeight TabbedWindow a
w) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit (TabbedWindow a -> Int
forall a. TabbedWindow a -> Int
twWindowWidth TabbedWindow a
w) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Widget Name -> Widget Name
forall n. Widget n -> Widget n
joinBorders (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel Widget Name
title (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
(TeamId -> TabbedWindow a -> Widget Name
forall a. (Eq a, Show a) => TeamId -> TabbedWindow a -> Widget Name
tabBar TeamId
tId TabbedWindow a
w Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
tabBody Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
hBorder Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter Widget Name
keybindingHelp)
keybindingHelp :: Widget Name
keybindingHelp :: Widget Name
keybindingHelp =
let pairs :: [(Text, [KeyEvent])]
pairs = [ (Text
"Switch tabs", [KeyEvent
SelectNextTabEvent, KeyEvent
SelectPreviousTabEvent])
, (Text
"Scroll", [KeyEvent
ScrollUpEvent, KeyEvent
ScrollDownEvent, KeyEvent
ScrollLeftEvent, KeyEvent
ScrollRightEvent, KeyEvent
PageLeftEvent, KeyEvent
PageRightEvent])
]
in [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
intersperse (Text -> Widget Name
forall n. Text -> Widget n
txt Text
" ") ([Widget Name] -> [Widget Name]) -> [Widget Name] -> [Widget Name]
forall a b. (a -> b) -> a -> b
$ ((Text -> [KeyEvent] -> Widget Name)
-> (Text, [KeyEvent]) -> Widget Name
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> [KeyEvent] -> Widget Name
renderKeybindingHelp) ((Text, [KeyEvent]) -> Widget Name)
-> [(Text, [KeyEvent])] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, [KeyEvent])]
pairs
tabBar :: (Eq a, Show a)
=> TeamId
-> TabbedWindow a
-> Widget Name
tabBar :: TeamId -> TabbedWindow a -> Widget Name
tabBar TeamId
tId TabbedWindow a
w =
let cur :: TabbedWindowEntry a
cur = TabbedWindow a -> TabbedWindowEntry a
forall a. (Show a, Eq a) => TabbedWindow a -> TabbedWindowEntry a
getCurrentTabbedWindowEntry TabbedWindow a
w
entries :: [TabbedWindowEntry a]
entries = TabbedWindowTemplate a -> [TabbedWindowEntry a]
forall a. TabbedWindowTemplate a -> [TabbedWindowEntry a]
twtEntries (TabbedWindow a -> TabbedWindowTemplate a
forall a. TabbedWindow a -> TabbedWindowTemplate a
twTemplate TabbedWindow a
w)
renderEntry :: TabbedWindowEntry a -> Widget n
renderEntry TabbedWindowEntry a
e =
let useAttr :: Widget n -> Widget n
useAttr = if Bool
isCurrent
then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
tabSelectedAttr
else AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
tabUnselectedAttr
isCurrent :: Bool
isCurrent = TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue TabbedWindowEntry a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue TabbedWindowEntry a
cur
makeVisible :: Widget n -> Widget n
makeVisible = if Bool
isCurrent then Widget n -> Widget n
forall n. Widget n -> Widget n
visible else Widget n -> Widget n
forall a. a -> a
id
decorateTab :: Widget n -> Widget n
decorateTab Widget n
v = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
v
let width :: Int
width = Image -> Int
Vty.imageWidth (Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL)
if Bool
isCurrent
then
Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Image -> Widget n
forall n. Image -> Widget n
raw (Image -> Widget n) -> Image -> Widget n
forall a b. (a -> b) -> a -> b
$ Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL
else
Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox [Image -> Widget n
forall n. Image -> Widget n
raw (Image -> Widget n) -> Image -> Widget n
forall a b. (a -> b) -> a -> b
$ Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n. Lens' (Result n) Image
imageL, Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
width Widget n
forall n. Widget n
hBorder]
in Widget n -> Widget n
forall n. Widget n -> Widget n
makeVisible (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Widget n -> Widget n
forall n. Widget n -> Widget n
decorateTab (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Widget n -> Widget n
forall n. Widget n -> Widget n
useAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
padLeftRight Int
2 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$
TabbedWindowEntry a -> a -> Bool -> Text
forall a. TabbedWindowEntry a -> a -> Bool -> Text
tweTitle TabbedWindowEntry a
e (TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue TabbedWindowEntry a
e) Bool
isCurrent
contents :: Widget n
contents = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
Context
ctx <- RenderM n Context
forall n. RenderM n Context
getContext
let width :: Int
width = Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL
Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
intersperse Widget n
forall n. Widget n
divider ([Widget n] -> [Widget n]) -> [Widget n] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ TabbedWindowEntry a -> Widget n
forall n. TabbedWindowEntry a -> Widget n
renderEntry (TabbedWindowEntry a -> Widget n)
-> [TabbedWindowEntry a] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TabbedWindowEntry a]
entries) [Widget n] -> [Widget n] -> [Widget n]
forall a. Semigroup a => a -> a -> a
<>
[Widget n
forall n. Widget n
divider, Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
width Widget n
forall n. Widget n
hBorder]
divider :: Widget n
divider = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 Widget n
forall n. Widget n
vBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
False Bool
False)
in Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
2 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (TeamId -> Name
TabbedWindowTabBar TeamId
tId) ViewportType
Horizontal Widget Name
forall n. Widget n
contents