{-|
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 Control.Lens
import Client.State
import Client.State.Focus
import Client.Configuration (LayoutMode(..))
import Client.Image.PackedImage (Image', unpackImage)
import Client.Image.StatusLine (statusLineImage, minorStatusLineImage)
import Client.Image.Textbox
import Client.Image.LineWrap (lineWrap, terminate)
import Client.Image.Palette
import Client.View
import Graphics.Vty.Image
import Graphics.Vty.Attributes (defAttr)

-- | 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 Getting LayoutMode ClientState LayoutMode
-> ClientState -> LayoutMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LayoutMode ClientState LayoutMode
Lens' ClientState LayoutMode
clientLayout ClientState
st of
    LayoutMode
TwoColumn | Bool -> Bool
not ([(Focus, Subfocus)] -> Bool
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      = Getting Int ClientState Int -> ClientState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ClientState Int
Lens' ClientState Int
clientWidth ClientState
st
    Int
h:[Int]
hs   = Int -> Int -> [Int]
splitHeights (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
saveRows) ([(Focus, Subfocus, [Image'])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Focus, Subfocus, [Image'])]
extraLines)
    scroll :: Int
scroll = Getting Int ClientState Int -> ClientState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ClientState Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h) Int
scroll ClientState
st

    output :: Image
output = [Image] -> Image
vertCat ([Image] -> Image) -> [Image] -> Image
forall a b. (a -> b) -> a -> b
$ [Image] -> [Image]
forall a. [a] -> [a]
reverse
           ([Image] -> [Image]) -> [Image] -> [Image]
forall a b. (a -> b) -> a -> b
$ Image
main
           Image -> [Image] -> [Image]
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)) <- [Int]
-> [(Focus, Subfocus, [Image'])]
-> [(Int, (Focus, Subfocus, [Image']))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
hs [(Focus, Subfocus, [Image'])]
extraLines]

    rows :: Int
rows = Getting Int ClientState Int -> ClientState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ClientState Int
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 Int -> Int -> Int
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 (Getting Int ClientState Int -> ClientState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ClientState Int
Lens' ClientState Int
clientWidth ClientState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
2
    hs :: [Int]
hs      = Int -> Int -> [Int]
divisions (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(Focus, Subfocus, [Image'])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Focus, Subfocus, [Image'])]
extraLines) ([(Focus, Subfocus, [Image'])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Focus, Subfocus, [Image'])]
extraLines)
    scroll :: Int
scroll = Getting Int ClientState Int -> ClientState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ClientState Int
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 ([Image] -> Image) -> [Image] -> Image
forall a b. (a -> b) -> a -> b
$ [Image] -> [Image]
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)) <- [Int]
-> [(Focus, Subfocus, [Image'])]
-> [(Int, (Focus, Subfocus, [Image']))]
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 = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
charFill (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palWindowDivider Palette
pal) Char
' ' Int
1 Int
rows
    rows :: Int
rows    = Getting Int ClientState Int -> ClientState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ClientState Int
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 = Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st
    subfocus :: Subfocus
subfocus = Getting Subfocus ClientState Subfocus -> ClientState -> Subfocus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Subfocus ClientState Subfocus
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' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
h Int -> Int -> Int
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    = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
charFill Attr
defAttr Char
' ' Int
w (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Image -> Int
imageHeight Image
vimg1)
             Image -> Image -> Image
<-> Image
vimg1

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

    assemble :: Image -> [Image'] -> Image
assemble Image
acc [Image']
_ | Image -> Int
imageHeight Image
acc Int -> Int -> Bool
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
             ([Image] -> Image) -> [Image] -> Image
forall a b. (a -> b) -> a -> b
$ (Image' -> Image) -> [Image'] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Image -> Image
terminate Int
w (Image -> Image) -> (Image' -> Image) -> Image' -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image' -> Image
unpackImage)
             ([Image'] -> [Image]) -> [Image'] -> [Image]
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ex) (Int
1 Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = []
  | Bool
otherwise = Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
r (Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r) Int
q
  where
    (Int
q,Int
r) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem (Int -> Int -> Int
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 Getting LayoutMode ClientState LayoutMode
-> ClientState -> LayoutMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LayoutMode ClientState LayoutMode
Lens' ClientState LayoutMode
clientLayout ClientState
st of
    LayoutMode
TwoColumn -> Int
h
    LayoutMode
OneColumn -> [Int] -> Int
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 = Getting LayoutMode ClientState LayoutMode
-> ClientState -> LayoutMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LayoutMode ClientState LayoutMode
Lens' ClientState LayoutMode
clientLayout ClientState
st

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

    bottomSize :: Int
bottomSize = Int
1 -- textbox
               Int -> Int -> Int
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 -> [Int] -> Int
forall a. [a] -> a
head (Int -> Int -> [Int]
divisions (Getting Int ClientState Int -> ClientState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ClientState Int
Lens' ClientState Int
clientWidth ClientState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
2)
        LayoutMode
OneColumn -> Getting Int ClientState Int -> ClientState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ClientState Int
Lens' ClientState Int
clientWidth ClientState
st