{-# Language BangPatterns #-}
module Client.Image
( clientPicture
, scrollAmount
) where
import Client.Image.Palette
import Client.Image.StatusLine
import Client.Image.Textbox
import Client.State
import Client.State.Focus
import Client.View
import Control.Lens
import Graphics.Vty (Background(..), Picture(..), Cursor(..))
import Graphics.Vty.Image
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
(mainHeight, splitHeight) = clientWindowHeights (imageHeight activityBar) st
splitFocuses = clientExtraFocuses st
focus = view clientFocus st
(pos , nextOffset, tbImg) = textboxImage st
!st' = set clientTextBoxOffset nextOffset
$ over clientScroll (max 0 . subtract overscroll) st
(overscroll, msgs) = messagePane mainHeight focus (view clientSubfocus st) st
splits = renderExtra st' <$> splitFocuses
img = vertCat splits <->
msgs <->
activityBar <->
statusLineImage st' <->
tbImg
activityBar = activityBarImage st
renderExtra stIn focus1 = outImg
where
(_,msgImg) = messagePane splitHeight focus1 FocusMessages stIn
pal = clientPalette stIn
divider = view palWindowDivider pal
outImg = msgImg <-> minorStatusLineImage focus1 stIn
<-> charFill divider ' ' (view clientWidth stIn) 1
messagePane ::
Int ->
Focus ->
Subfocus ->
ClientState ->
(Int, Image)
messagePane h focus subfocus st = (overscroll, img)
where
images = viewLines focus subfocus st
vimg = assemble emptyImage images
vimg1 = cropBottom h vimg
img = pad 0 (h - imageHeight vimg1) 0 0 vimg1
overscroll = vh - imageHeight vimg
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
w = view clientWidth st
lineWrap ::
Int ->
Image ->
Image
lineWrap w img
| imageWidth img > w = cropRight w img <->
lineWrap w (cropLeft (imageWidth img - w) img)
| otherwise = img <|> char defAttr ' '
scrollAmount ::
ClientState ->
Int
scrollAmount st = max 1 (snd (clientWindowHeights actSize st))
where
actSize = imageHeight (activityBarImage st)
clientWindowHeights ::
Int ->
ClientState ->
(Int,Int)
clientWindowHeights activityBar st =
(max 0 (h - overhead - extras*d), max 0 (d-overhead))
where
d = h `quot` (1 + extras)
h = max 0 (view clientHeight st - activityBar)
extras = length (clientExtraFocuses st)
overhead = 2