{-# Language BangPatterns #-}
module Client.Image (clientPicture) where
import Client.Configuration
import Client.Image.ChannelInfo
import Client.Image.Help
import Client.Image.MaskList
import Client.Image.Message
import Client.Image.Palette
import Client.Image.PaletteView
import Client.Image.StatusLine
import Client.Image.Textbox
import Client.Image.UserList
import Client.Image.Windows
import Client.Message
import Client.State
import Client.State.Focus
import Client.State.Network
import Client.State.Window
import Control.Lens
import Graphics.Vty (Background(..), Picture(..), Cursor(..))
import Graphics.Vty.Image
import Irc.Identifier (Identifier)
clientPicture :: ClientState -> (Picture, ClientState)
clientPicture st = (pic, st')
where
(pos, img, st') = clientImage st
pic = Picture
{ picCursor = AbsoluteCursor pos (view clientHeight st - 1)
, picBackground = ClearBackground
, picLayers = [img]
}
clientImage ::
ClientState ->
(Int, Image, ClientState)
clientImage st = (pos, img, st')
where
(mp, st') = messagePane st
(pos, tbImg) = textboxImage st'
img = mp <-> statusLineImage st' <-> tbImg
messagePaneImages :: ClientState -> [Image]
messagePaneImages !st =
case (view clientFocus st, view clientSubfocus st) of
(ChannelFocus network channel, FocusInfo) ->
channelInfoImages network channel st
(ChannelFocus network channel, FocusUsers)
| view clientDetailView st -> userInfoImages network channel st
| otherwise -> userListImages network channel st
(ChannelFocus network channel, FocusMasks mode) ->
maskListImages mode network channel st
(_, FocusWindows) -> windowsImages st
(_, FocusPalette) -> paletteViewLines pal
(_, FocusHelp mb) -> helpImageLines mb pal
_ -> chatMessageImages st
where
pal = view (clientConfig . configPalette) st
chatMessageImages :: ClientState -> [Image]
chatMessageImages st = windowLineProcessor focusedMessages
where
matcher = clientMatcher st
focusedMessages
= filter (views wlText matcher)
$ view (clientWindows . ix (view clientFocus st) . winMessages) st
windowLineProcessor
| view clientDetailView st = map (view wlFullImage)
| otherwise = windowLinesToImages st . filter (not . isNoisy)
isNoisy msg =
case view wlBody msg of
IrcBody irc -> squelchIrcMsg irc
_ -> False
messagePane :: ClientState -> (Image, ClientState)
messagePane st = (img, st')
where
images = messagePaneImages st
vimg = assemble emptyImage images
vimg1 = cropBottom h vimg
img = pad 0 (h - imageHeight vimg1) 0 0 vimg1
overscroll = vh - imageHeight vimg
st' = over clientScroll (max 0 . subtract overscroll) st
assemble acc _ | imageHeight acc >= vh = cropTop vh acc
assemble acc [] = acc
assemble acc (x:xs) = assemble (lineWrap w x <-> acc) xs
scroll = view clientScroll st
vh = h + scroll
reservedLines
| view clientActivityBar st = 3
| otherwise = 2
h = view clientHeight st - reservedLines
w = view clientWidth st
windowLinesToImages :: ClientState -> [WindowLine] -> [Image]
windowLinesToImages st wwls =
case gatherMetadataLines st wwls of
([], []) -> []
([], w:ws) -> view wlImage w : windowLinesToImages st ws
((img,who,mbnext):mds, wls) ->
startMetadata img mbnext who mds palette
: windowLinesToImages st wls
where
palette = view (clientConfig . configPalette) st
type MetadataState =
Identifier ->
[(Image,Identifier,Maybe Identifier)] ->
Palette ->
Image
startMetadata ::
Image ->
Maybe Identifier ->
MetadataState
startMetadata img mbnext who mds palette =
quietIdentifier palette who
<|> img
<|> transitionMetadata mbnext who mds palette
transitionMetadata ::
Maybe Identifier ->
MetadataState
transitionMetadata mbwho who mds palette =
case mbwho of
Nothing -> continueMetadata who mds palette
Just who' -> quietIdentifier palette who'
<|> continueMetadata who' mds palette
continueMetadata :: MetadataState
continueMetadata _ [] _ = emptyImage
continueMetadata who1 ((img, who2, mbwho3):mds) palette
| who1 == who2 = img
<|> transitionMetadata mbwho3 who2 mds palette
| otherwise = char defAttr ' '
<|> startMetadata img mbwho3 who2 mds palette
gatherMetadataLines ::
ClientState ->
[WindowLine] ->
( [(Image, Identifier, Maybe Identifier)] , [ WindowLine ] )
gatherMetadataLines st = go []
where
go acc (w:ws)
| Just (img,who,mbnext) <- metadataWindowLine st w =
go ((img,who,mbnext) : acc) ws
go acc ws = (acc,ws)
metadataWindowLine ::
ClientState ->
WindowLine ->
Maybe (Image, Identifier, Maybe Identifier)
metadataWindowLine st wl =
case view wlBody wl of
IrcBody irc
| Just who <- ircIgnorable irc st -> Just (ignoreImage, who, Nothing)
| otherwise -> metadataImg irc
_ -> Nothing
lineWrap :: Int -> Image -> Image
lineWrap w img
| imageWidth img > w = cropRight w img <-> lineWrap w (cropLeft (imageWidth img - w) img)
| otherwise = img <|> char defAttr ' '