{-# Language OverloadedStrings #-}
module Client.View.Windows
( windowsImages
) where
import Client.Image.Message (coloredIdentifier, IdentifierColorMode (NormalIdentifier))
import Client.Image.PackedImage
import Client.Image.Palette
import Client.State
import Client.State.Focus
import Client.State.Window
import Client.State.Network
import Control.Lens
import qualified Data.HashMap.Strict as HashMap
import Data.List
import Data.Maybe (fromMaybe)
import qualified Data.Map as Map
import Graphics.Vty.Attributes
windowsImages :: WindowsFilter -> ClientState -> [Image']
windowsImages :: WindowsFilter -> ClientState -> [Image']
windowsImages WindowsFilter
filt ClientState
st
= forall a. [a] -> [a]
reverse
forall a b. (a -> b) -> a -> b
$ [[Image']] -> [Image']
createColumns
forall a b. (a -> b) -> a -> b
$ [ Palette -> Image' -> Focus -> Window -> [Image']
renderWindowColumns Palette
pal (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) Char
'h') Focus
k Window
v | (Focus
k,Window
v) <- [(Focus, Window)]
hiddenWindows ] forall a. [a] -> [a] -> [a]
++
[ Palette -> Image' -> Focus -> Window -> [Image']
renderWindowColumns Palette
pal (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palWindowName Palette
pal) (Window -> Char
name Window
v)) Focus
k Window
v | (Focus
k,Window
v) <- [(Focus, Window)]
windows ]
where
pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
name :: Window -> Char
name = forall a. a -> Maybe a -> a
fromMaybe Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window (Maybe Char)
winName
([(Focus, Window)]
hiddenWindows, [(Focus, Window)]
windows)
= forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Window Bool
winHidden))
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (WindowsFilter -> ClientState -> Focus -> Bool
windowMatcher WindowsFilter
filt ClientState
st forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toAscList
forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (Map Focus Window)
clientWindows ClientState
st
windowMatcher :: WindowsFilter -> ClientState -> Focus -> Bool
windowMatcher :: WindowsFilter -> ClientState -> Focus -> Bool
windowMatcher WindowsFilter
AllWindows ClientState
_ Focus
_ = Bool
True
windowMatcher WindowsFilter
NetworkWindows ClientState
_ NetworkFocus{} = Bool
True
windowMatcher WindowsFilter
ChannelWindows ClientState
st (ChannelFocus Text
net Identifier
chan) =
case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
net) ClientState
st of
Just NetworkState
cs -> NetworkState -> Identifier -> Bool
isChannelIdentifier NetworkState
cs Identifier
chan
Maybe NetworkState
Nothing -> Bool
True
windowMatcher WindowsFilter
UserWindows ClientState
st (ChannelFocus Text
net Identifier
chan) =
case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
net) ClientState
st of
Just NetworkState
cs -> Bool -> Bool
not (NetworkState -> Identifier -> Bool
isChannelIdentifier NetworkState
cs Identifier
chan)
Maybe NetworkState
Nothing -> Bool
True
windowMatcher WindowsFilter
_ ClientState
_ Focus
_ = Bool
False
renderWindowColumns :: Palette -> Image' -> Focus -> Window -> [Image']
renderWindowColumns :: Palette -> Image' -> Focus -> Window -> [Image']
renderWindowColumns Palette
pal Image'
name Focus
focus Window
win =
[ Image'
name
, Palette -> Focus -> Image'
renderedFocus Palette
pal Focus
focus
, Palette -> Window -> Image'
renderedWindowInfo Palette
pal Window
win
]
createColumns :: [[Image']] -> [Image']
createColumns :: [[Image']] -> [Image']
createColumns [[Image']]
xs = forall a b. (a -> b) -> [a] -> [b]
map [Image'] -> Image'
makeRow [[Image']]
xs
where
columnWidths :: [Int]
columnWidths = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Image' -> Int
imageWidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [[a]] -> [[a]]
transpose [[Image']]
xs
makeRow :: [Image'] -> Image'
makeRow = forall a. Monoid a => [a] -> a
mconcat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (Attr -> Char -> Image'
char Attr
defAttr Char
' ')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Image' -> Image'
resizeImage [Int]
columnWidths
renderedFocus :: Palette -> Focus -> Image'
renderedFocus :: Palette -> Focus -> Image'
renderedFocus Palette
pal Focus
focus =
case Focus
focus of
Focus
Unfocused ->
Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) Char
'*'
NetworkFocus Text
network ->
Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) Text
network
ChannelFocus Text
network Identifier
channel ->
Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) Text
network forall a. Semigroup a => a -> a -> a
<>
Attr -> Char -> Image'
char Attr
defAttr Char
':' forall a. Semigroup a => a -> a -> a
<>
Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier forall k v. HashMap k v
HashMap.empty Identifier
channel
renderedWindowInfo :: Palette -> Window -> Image'
renderedWindowInfo :: Palette -> Window -> Image'
renderedWindowInfo Palette
pal Window
win =
Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Attr -> Const Attr Attr) -> Palette -> Const Attr Palette
newMsgAttrLens Palette
pal) (forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' Window Int
winUnread forall a. Show a => a -> String
show Window
win) forall a. Semigroup a => a -> a -> a
<> Image'
"/" forall a. Semigroup a => a -> a -> a
<>
Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palActivity Palette
pal) (forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' Window Int
winTotal forall a. Show a => a -> String
show Window
win) forall a. Semigroup a => a -> a -> a
<>
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window ActivityFilter
winActivityFilter Window
win of
ActivityFilter
AFLoud -> forall a. Monoid a => a
mempty
ActivityFilter
other -> Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palMeta Palette
pal) (Char
' 'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show ActivityFilter
other)
where
newMsgAttrLens :: (Attr -> Const Attr Attr) -> Palette -> Const Attr Palette
newMsgAttrLens =
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window WindowLineImportance
winMention Window
win of
WindowLineImportance
WLImportant -> Lens' Palette Attr
palMention
WindowLineImportance
_ -> Lens' Palette Attr
palActivity