{-# LANGUAGE BangPatterns #-}
module Client.Image
( clientPicture
, scrollAmount
) where
import Client.Image.Palette
import Client.Image.StatusLine
import Client.Image.Textbox
import Client.Image.Utils
import Client.State
import Client.State.Focus
import Client.View
import Control.Lens
import Graphics.Vty (Background (..), Cursor (..),
Picture (..))
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 statusLine) 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 <->
statusLine <->
tbImg
statusLine = statusLineImage 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 Nothing x <-> acc) xs
scroll = view clientScroll st
vh = h + scroll
w = view clientWidth st
scrollAmount ::
ClientState ->
Int
scrollAmount st = max 1 (snd (clientWindowHeights actSize st))
where
actSize = imageHeight (statusLineImage st)
clientWindowHeights ::
Int ->
ClientState ->
(Int,Int)
clientWindowHeights statusBar st = (mainH, splitH)
where
h = max 0 (view clientHeight st - overhead)
splitH = h `quot` (1+extras)
mainH = h - splitH*extras
extras = length (clientExtraFocuses st)
textbox = 1
overhead = textbox + statusBar + 2*extras