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
drawTabbedWindow :: (Eq a, Show a)
=> TabbedWindow ChatState m Name a
-> ChatState
-> TeamId
-> Widget Name
drawTabbedWindow :: forall a (m :: * -> *).
(Eq a, Show a) =>
TabbedWindow ChatState m Name a
-> ChatState -> TeamId -> Widget Name
drawTabbedWindow TabbedWindow ChatState m Name a
w ChatState
cs TeamId
tId =
let cur :: TabbedWindowEntry ChatState m Name a
cur = forall a s (m :: * -> *) n.
(Show a, Eq a) =>
TabbedWindow s m n a -> TabbedWindowEntry s m n a
getCurrentTabbedWindowEntry TabbedWindow ChatState m Name a
w
tabBody :: Widget Name
tabBody = forall s (m :: * -> *) n a.
TabbedWindowEntry s m n a -> a -> s -> Widget n
tweRender TabbedWindowEntry ChatState m Name a
cur (forall s (m :: * -> *) n a. TabbedWindow s m n a -> a
twValue TabbedWindow ChatState m Name a
w) ChatState
cs
title :: Widget Name
title = forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> a -> Widget n
twtTitle (forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate TabbedWindow ChatState m Name a
w) (forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry ChatState m Name a
cur)
in forall n. Widget n -> Widget n
centerLayer forall a b. (a -> b) -> a -> b
$
forall n. Int -> Widget n -> Widget n
vLimit (forall s (m :: * -> *) n a. TabbedWindow s m n a -> Int
twWindowHeight TabbedWindow ChatState m Name a
w) forall a b. (a -> b) -> a -> b
$
forall n. Int -> Widget n -> Widget n
hLimit (forall s (m :: * -> *) n a. TabbedWindow s m n a -> Int
twWindowWidth TabbedWindow ChatState m Name a
w) forall a b. (a -> b) -> a -> b
$
forall n. Widget n -> Widget n
joinBorders forall a b. (a -> b) -> a -> b
$
forall n. Widget n -> Widget n -> Widget n
borderWithLabel Widget Name
title forall a b. (a -> b) -> a -> b
$
(forall a s (m :: * -> *).
(Eq a, Show a) =>
TeamId -> TabbedWindow s m Name a -> Widget Name
tabBar TeamId
tId TabbedWindow ChatState m Name a
w forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
tabBody forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n -> Widget n
hCenter (ChatState -> Widget Name
keybindingHelp ChatState
cs))
keybindingHelp :: ChatState -> Widget Name
keybindingHelp :: ChatState -> Widget Name
keybindingHelp ChatState
st =
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 forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (forall n. Text -> Widget n
txt Text
" ") forall a b. (a -> b) -> a -> b
$ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ChatState -> Text -> [KeyEvent] -> Widget Name
renderKeybindingHelp ChatState
st)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, [KeyEvent])]
pairs
tabBar :: (Eq a, Show a)
=> TeamId
-> TabbedWindow s m Name a
-> Widget Name
tabBar :: forall a s (m :: * -> *).
(Eq a, Show a) =>
TeamId -> TabbedWindow s m Name a -> Widget Name
tabBar TeamId
tId TabbedWindow s m Name a
w =
let cur :: TabbedWindowEntry s m Name a
cur = forall a s (m :: * -> *) n.
(Show a, Eq a) =>
TabbedWindow s m n a -> TabbedWindowEntry s m n a
getCurrentTabbedWindowEntry TabbedWindow s m Name a
w
entries :: [TabbedWindowEntry s m Name a]
entries = forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries (forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate TabbedWindow s m Name a
w)
renderEntry :: TabbedWindowEntry s m n a -> Widget n
renderEntry TabbedWindowEntry s m n a
e =
let useAttr :: Widget n -> Widget n
useAttr = if Bool
isCurrent
then forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
tabSelectedAttr
else forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
tabUnselectedAttr
isCurrent :: Bool
isCurrent = forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m n a
e forall a. Eq a => a -> a -> Bool
== forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m Name a
cur
makeTabVisible :: Widget n -> Widget n
makeTabVisible = if Bool
isCurrent then forall n. Widget n -> Widget n
visible else forall a. a -> a
id
decorateTab :: Widget n -> Widget n
decorateTab Widget n
v = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
v
let width :: Int
width = Image -> Int
Vty.imageWidth (Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL)
if Bool
isCurrent
then
forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n. Result n -> Widget n
resultToWidget Result n
result
else
forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox [ forall n. Result n -> Widget n
resultToWidget Result n
result
, forall n. Int -> Widget n -> Widget n
hLimit Int
width forall n. Widget n
hBorder
]
in forall n. Widget n -> Widget n
makeTabVisible forall a b. (a -> b) -> a -> b
$
forall n. Widget n -> Widget n
decorateTab forall a b. (a -> b) -> a -> b
$
forall n. Widget n -> Widget n
useAttr forall a b. (a -> b) -> a -> b
$
forall n. Int -> Widget n -> Widget n
padLeftRight Int
2 forall a b. (a -> b) -> a -> b
$
forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$
forall s (m :: * -> *) n a.
TabbedWindowEntry s m n a -> a -> Bool -> Text
tweTitle TabbedWindowEntry s m n a
e (forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m n a
e) Bool
isCurrent
contents :: Widget n
contents = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
Context n
ctx <- forall n. RenderM n (Context n)
getContext
let width :: Int
width = Context n
ctxforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL
forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ (forall a. a -> [a] -> [a]
intersperse forall n. Widget n
divider forall a b. (a -> b) -> a -> b
$ forall {s} {m :: * -> *} {n} {n}.
TabbedWindowEntry s m n a -> Widget n
renderEntry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TabbedWindowEntry s m Name a]
entries) forall a. Semigroup a => a -> a -> a
<>
[forall n. Widget n
divider, forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
width forall n. Widget n
hBorder]
divider :: Widget n
divider = forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall n. Widget n
vBorder forall n. Widget n -> Widget n -> Widget n
<=> forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
False Bool
False)
in forall n. Int -> Widget n -> Widget n
vLimit Int
2 forall a b. (a -> b) -> a -> b
$ forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (TeamId -> Name
TabbedWindowTabBar TeamId
tId) ViewportType
Horizontal forall n. Widget n
contents