Image.hs

{-# Language BangPatterns #-}
{-|
Module      : Client.Image
Description : UI renderer
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides the renderer for the client's UI.

-}
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

-- | Generate a 'Picture' for the current client state. The resulting
-- client state is updated for render specific information like scrolling.
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]
              }

-- | Primary UI render logic
clientImage ::
  ClientState               {- ^ client state -} ->
  (Int, Image, ClientState) {- ^ text box cursor position, image, updated state -}
clientImage st = (pos, img, st')
  where
    (mainHeight, splitHeight) = clientWindowHeights (imageHeight activityBar) st
    splitFocuses              = clientExtraFocuses st
    focus                     = view clientFocus st
    (pos , tbImg )            = textboxImage st

    -- update client state for scroll clamp
    st' = over clientScroll (max 0 . subtract overscroll) st

    (overscroll, msgs) = messagePane mainHeight focus (view clientSubfocus st) st
    splits = renderExtra st' <$> splitFocuses
    -- outgoing state is ignored here, splits don't get to truncate scrollback

    img = vertCat splits      <->
          msgs                <->
          activityBar         <->
          statusLineImage st' <->
          tbImg

    activityBar = activityBarImage st
        -- must be st, not st', needed to compute window heights
        -- before rendering the message panes

    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

-- | Generate an image corresponding to the image lines of the given
-- focus and subfocus. Returns the number of lines overscrolled to
-- assist in clamping scroll to the lines available in the window.
messagePane ::
  Int          {- ^ available rows                -} ->
  Focus        {- ^ focused window                -} ->
  Subfocus     {- ^ subfocus to render            -} ->
  ClientState  {- ^ client state                  -} ->
  (Int, Image) {- ^ overscroll, rendered messages -}
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

-- | Given an image, break the image up into chunks of at most the
-- given width and stack the resulting chunks vertically top-to-bottom.
lineWrap ::
  Int   {- ^ maximum image width -} ->
  Image {- ^ unwrapped image     -} ->
  Image {- ^ wrapped image       -}
lineWrap w img
  | imageWidth img > w = cropRight w img <->
                         lineWrap w (cropLeft (imageWidth img - w) img)
  | otherwise = img <|> char defAttr ' '
      -- trailing space with default attributes deals with bug in VTY
      -- where the formatting will continue past the end of chat messages


-- | Compute the number of lines in a page at the current window size
scrollAmount ::
  ClientState {- ^ client state              -} ->
  Int         {- ^ scroll amount             -}
scrollAmount st = max 1 (snd (clientWindowHeights actSize st))
               -- extra will be equal to main or 1 smaller
  where
    actSize = imageHeight (activityBarImage st)


-- | Number of lines to allocate for the focused window and the
-- main window. This doesn't include the textbox, activity bar,
-- or status line.
clientWindowHeights ::
  Int         {- ^ activity bar height       -} ->
  ClientState {- ^ client state              -} ->
  (Int,Int)   {- ^ main height, extra height -}
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) -- lines available

    extras   = length (clientExtraFocuses st)

    overhead = 2 -- status line and textbox/divider