{-|
Module      : Client.Image.Layout
Description : Layout code for the multi-window splits
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

-}
module Client.Image.Layout (scrollAmount, drawLayout) where

import Client.Configuration (LayoutMode(..))
import Client.Image.LineWrap (lineWrap, terminate)
import Client.Image.PackedImage (Image', unpackImage)
import Client.Image.Palette (palWindowDivider)
import Client.Image.StatusLine (statusLineImage, minorStatusLineImage)
import Client.Image.Textbox (textboxImage)
import Client.State
import Client.State.Focus ( Focus, Subfocus )
import Client.View (viewLines)
import Control.Lens (view)
import Graphics.Vty.Attributes (defAttr)
import Graphics.Vty.Image

-- | Compute the combined image for all the visible message windows.
drawLayout ::
  ClientState            {- ^ client state                                     -} ->
  (Int, Int, Int, Int, Image) {- ^ overscroll, cursor row, cursor col, next offset, final image -}
drawLayout :: ClientState -> (Int, Int, Int, Int, Image)
drawLayout ClientState
st =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState LayoutMode
clientLayout ClientState
st of
    LayoutMode
TwoColumn | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Focus, Subfocus)]
extrafocus) -> ClientState -> [(Focus, Subfocus)] -> (Int, Int, Int, Int, Image)
drawLayoutTwo ClientState
st [(Focus, Subfocus)]
extrafocus
    LayoutMode
_                                 -> ClientState -> [(Focus, Subfocus)] -> (Int, Int, Int, Int, Image)
drawLayoutOne ClientState
st [(Focus, Subfocus)]
extrafocus
  where
    extrafocus :: [(Focus, Subfocus)]
extrafocus = ClientState -> [(Focus, Subfocus)]
clientExtraFocuses ClientState
st

-- | Layout algorithm for all windows in a single column.
drawLayoutOne ::
  ClientState            {- ^ client state                 -} ->
  [(Focus, Subfocus)]    {- ^ extra windows                -} ->
  (Int, Int, Int, Int, Image) {- ^ overscroll and final image   -}
drawLayoutOne :: ClientState -> [(Focus, Subfocus)] -> (Int, Int, Int, Int, Image)
drawLayoutOne ClientState
st [(Focus, Subfocus)]
extrafocus =
  (Int
overscroll, Int
row, Int
col, Int
nextOffset, Image
output)
  where
    w :: Int
w      = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Int
clientWidth ClientState
st
    Int
h:[Int]
hs   = Int -> Int -> [Int]
splitHeights (Int
rows forall a. Num a => a -> a -> a
- Int
saveRows) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Focus, Subfocus, [Image'])]
extraLines)
    scroll :: Int
scroll = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Int
clientScroll ClientState
st

    (Int
overscroll, Int
row, Int
col, Int
nextOffset, Image
main) =
        Int -> Int -> Int -> ClientState -> (Int, Int, Int, Int, Image)
drawMain Int
w (Int
saveRows forall a. Num a => a -> a -> a
+ Int
h) Int
scroll ClientState
st

    output :: Image
output = [Image] -> Image
vertCat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse
           forall a b. (a -> b) -> a -> b
$ Image
main
           forall a. a -> [a] -> [a]
: [ ClientState -> Int -> Int -> Focus -> Subfocus -> [Image'] -> Image
drawExtra ClientState
st Int
w Int
h' Focus
foc Subfocus
subfoc [Image']
imgs
                 | (Int
h', (Focus
foc, Subfocus
subfoc, [Image']
imgs)) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
hs [(Focus, Subfocus, [Image'])]
extraLines]

    rows :: Int
rows = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Int
clientHeight ClientState
st

    -- don't count textbox or the main status line against the main window's height
    saveRows :: Int
saveRows = Int
1 forall a. Num a => a -> a -> a
+ Image -> Int
imageHeight (Int -> ClientState -> Image
statusLineImage Int
w ClientState
st)

    extraLines :: [(Focus, Subfocus, [Image'])]
extraLines = [ (Focus
focus, Subfocus
subfocus, Focus -> Subfocus -> Int -> ClientState -> [Image']
viewLines Focus
focus Subfocus
subfocus Int
w ClientState
st)
                   | (Focus
focus, Subfocus
subfocus) <- [(Focus, Subfocus)]
extrafocus ]

-- | Layout algorithm for all windows in a single column.
drawLayoutTwo ::
  ClientState            {- ^ client state                                -} ->
  [(Focus, Subfocus)]    {- ^ extra windows                               -} ->
  (Int, Int, Int, Int, Image) {- ^ overscroll, cursor row, cursor col, offset, final image -}
drawLayoutTwo :: ClientState -> [(Focus, Subfocus)] -> (Int, Int, Int, Int, Image)
drawLayoutTwo ClientState
st [(Focus, Subfocus)]
extrafocus =
  (Int
overscroll, Int
row, Int
col, Int
nextOffset, Image
output)
  where
    [Int
wl,Int
wr] = Int -> Int -> [Int]
divisions (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Int
clientWidth ClientState
st forall a. Num a => a -> a -> a
- Int
1) Int
2
    hs :: [Int]
hs      = Int -> Int -> [Int]
divisions (Int
rows forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Focus, Subfocus, [Image'])]
extraLines) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Focus, Subfocus, [Image'])]
extraLines)
    scroll :: Int
scroll = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Int
clientScroll ClientState
st

    output :: Image
output = Image
main Image -> Image -> Image
<|> Image
divider Image -> Image -> Image
<|> Image
extraImgs

    extraImgs :: Image
extraImgs = [Image] -> Image
vertCat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse
             [ ClientState -> Int -> Int -> Focus -> Subfocus -> [Image'] -> Image
drawExtra ClientState
st Int
wr Int
h' Focus
foc Subfocus
subfoc [Image']
imgs
                 | (Int
h', (Focus
foc, Subfocus
subfoc, [Image']
imgs)) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
hs [(Focus, Subfocus, [Image'])]
extraLines]

    (Int
overscroll, Int
row, Int
col, Int
nextOffset, Image
main) =
        Int -> Int -> Int -> ClientState -> (Int, Int, Int, Int, Image)
drawMain Int
wl Int
rows Int
scroll ClientState
st

    pal :: Palette
pal     = ClientState -> Palette
clientPalette ClientState
st
    divider :: Image
divider = forall d. Integral d => Attr -> Char -> d -> d -> Image
charFill (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palWindowDivider Palette
pal) Char
' ' Int
1 Int
rows
    rows :: Int
rows    = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Int
clientHeight ClientState
st

    extraLines :: [(Focus, Subfocus, [Image'])]
extraLines = [ (Focus
focus, Subfocus
subfocus, Focus -> Subfocus -> Int -> ClientState -> [Image']
viewLines Focus
focus Subfocus
subfocus Int
wr ClientState
st)
                   | (Focus
focus, Subfocus
subfocus) <- [(Focus, Subfocus)]
extrafocus ]

drawMain ::
  Int         {- ^ draw width      -} ->
  Int         {- ^ draw height     -} ->
  Int         {- ^ scroll amount   -} ->
  ClientState {- ^ client state    -} ->
  (Int,Int,Int,Int,Image)
drawMain :: Int -> Int -> Int -> ClientState -> (Int, Int, Int, Int, Image)
drawMain Int
w Int
h Int
scroll ClientState
st = (Int
overscroll, Int
row, Int
col, Int
nextOffset, Image
msgs Image -> Image -> Image
<-> Image
bottomImg)
  where
    focus :: Focus
focus = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Focus
clientFocus ClientState
st
    subfocus :: Subfocus
subfocus = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Subfocus
clientSubfocus ClientState
st

    msgLines :: [Image']
msgLines = Focus -> Subfocus -> Int -> ClientState -> [Image']
viewLines Focus
focus Subfocus
subfocus Int
w ClientState
st

    (Int
overscroll, Image
msgs) = Int -> Int -> Int -> [Image'] -> (Int, Image)
messagePane Int
w Int
h' Int
scroll [Image']
msgLines

    h' :: Int
h' = forall a. Ord a => a -> a -> a
max Int
0 (Int
h forall a. Num a => a -> a -> a
- Image -> Int
imageHeight Image
bottomImg)

    bottomImg :: Image
bottomImg = Int -> ClientState -> Image
statusLineImage Int
w ClientState
st Image -> Image -> Image
<-> Image
tbImage
    (Int
row, Int
col, Int
nextOffset, Image
tbImage) = Int -> Int -> ClientState -> (Int, Int, Int, Image)
textboxImage Int
3 Int
w ClientState
st


-- | Draw one of the extra windows from @/splits@
drawExtra ::
  ClientState {- ^ client state    -} ->
  Int         {- ^ draw width      -} ->
  Int         {- ^ draw height     -} ->
  Focus       {- ^ focus           -} ->
  Subfocus    {- ^ subfocus        -} ->
  [Image']    {- ^ image lines     -} ->
  Image       {- ^ rendered window -}
drawExtra :: ClientState -> Int -> Int -> Focus -> Subfocus -> [Image'] -> Image
drawExtra ClientState
st Int
w Int
h Focus
focus Subfocus
subfocus [Image']
lineImages =
    Image
msgImg Image -> Image -> Image
<-> Image' -> Image
unpackImage (Focus -> Subfocus -> Int -> Bool -> ClientState -> Image'
minorStatusLineImage Focus
focus Subfocus
subfocus Int
w Bool
True ClientState
st)
  where
    (Int
_, Image
msgImg) = Int -> Int -> Int -> [Image'] -> (Int, Image)
messagePane Int
w Int
h Int
0 [Image']
lineImages


-- | 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          {- ^ client width                  -} ->
  Int          {- ^ available rows                -} ->
  Int          {- ^ current scroll                -} ->
  [Image']     {- ^ focused window                -} ->
  (Int, Image) {- ^ overscroll, rendered messages -}
messagePane :: Int -> Int -> Int -> [Image'] -> (Int, Image)
messagePane Int
w Int
h Int
scroll [Image']
images = (Int
overscroll, Image
img)
  where
    vimg :: Image
vimg   = Image -> [Image'] -> Image
assemble Image
emptyImage [Image']
images
    vimg1 :: Image
vimg1  = Int -> Image -> Image
cropBottom Int
h Image
vimg
    img :: Image
img    = forall d. Integral d => Attr -> Char -> d -> d -> Image
charFill Attr
defAttr Char
' ' Int
w (Int
h forall a. Num a => a -> a -> a
- Image -> Int
imageHeight Image
vimg1)
             Image -> Image -> Image
<-> Image
vimg1

    overscroll :: Int
overscroll = Int
vh forall a. Num a => a -> a -> a
- Image -> Int
imageHeight Image
vimg
    vh :: Int
vh         = Int
h forall a. Num a => a -> a -> a
+ Int
scroll

    assemble :: Image -> [Image'] -> Image
assemble Image
acc [Image']
_ | Image -> Int
imageHeight Image
acc forall a. Ord a => a -> a -> Bool
>= Int
vh = Int -> Image -> Image
cropTop Int
vh Image
acc
    assemble Image
acc [] = Image
acc
    assemble Image
acc (Image'
x:[Image']
xs) = Image -> [Image'] -> Image
assemble (Image
this Image -> Image -> Image
<-> Image
acc) [Image']
xs
      where
        this :: Image
this = [Image] -> Image
vertCat
             forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> Image -> Image
terminate Int
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image' -> Image
unpackImage)
             forall a b. (a -> b) -> a -> b
$ Int -> Image' -> [Image']
lineWrap Int
w Image'
x


splitHeights ::
  Int   {- ^ screen rows to fill               -} ->
  Int   {- ^ number of extra windows           -} ->
  [Int] {- ^ list of heights for each division -}
splitHeights :: Int -> Int -> [Int]
splitHeights Int
h Int
ex = Int -> Int -> [Int]
divisions (Int
h forall a. Num a => a -> a -> a
- Int
ex) (Int
1 forall a. Num a => a -> a -> a
+ Int
ex)


-- | Constructs a list of numbers with the length of the divisor
-- and that sums to the dividend. Each element will be within
-- one of the quotient.
divisions ::
  Int {- ^ dividend -} ->
  Int {- ^ divisor  -} ->
  [Int]
divisions :: Int -> Int -> [Int]
divisions Int
x Int
y
  | Int
y forall a. Ord a => a -> a -> Bool
<= Int
0    = []
  | Bool
otherwise = forall a. Int -> a -> [a]
replicate Int
r (Int
qforall a. Num a => a -> a -> a
+Int
1) forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
yforall a. Num a => a -> a -> a
-Int
r) Int
q
  where
    (Int
q,Int
r) = forall a. Integral a => a -> a -> (a, a)
quotRem (forall a. Ord a => a -> a -> a
max Int
0 Int
x) Int
y



-- | Compute the number of lines in a page at the current window size
scrollAmount ::
  ClientState {- ^ client state  -} ->
  Int         {- ^ scroll amount -}
scrollAmount :: ClientState -> Int
scrollAmount ClientState
st =
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState LayoutMode
clientLayout ClientState
st of
    LayoutMode
TwoColumn -> Int
h
    LayoutMode
OneColumn -> forall a. [a] -> a
head (Int -> Int -> [Int]
splitHeights Int
h Int
ex) -- extra will be equal to main or 1 smaller
  where
    layout :: LayoutMode
layout = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState LayoutMode
clientLayout ClientState
st

    h :: Int
h = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Int
clientHeight ClientState
st forall a. Num a => a -> a -> a
- Int
bottomSize
    ex :: Int
ex = forall (t :: * -> *) a. Foldable t => t a -> Int
length (ClientState -> [(Focus, Subfocus)]
clientExtraFocuses ClientState
st)

    bottomSize :: Int
bottomSize = Int
1 -- textbox
               forall a. Num a => a -> a -> a
+ Image -> Int
imageHeight (Int -> ClientState -> Image
statusLineImage Int
mainWidth ClientState
st)

    mainWidth :: Int
mainWidth =
      case LayoutMode
layout of
        LayoutMode
TwoColumn -> forall a. [a] -> a
head (Int -> Int -> [Int]
divisions (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Int
clientWidth ClientState
st forall a. Num a => a -> a -> a
- Int
1) Int
2)
        LayoutMode
OneColumn -> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Int
clientWidth ClientState
st