{-|
Module      : Client.Image.LineWrap
Description : Chat message view
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

Provides utilities for line wrapping images.
-}

module Client.Image.LineWrap
  ( lineWrap
  , lineWrapPrefix
  , fullLineWrap
  , terminate
  ) where

import           Client.Image.PackedImage
import qualified Graphics.Vty.Image as Vty
import           Graphics.Vty.Attributes
import qualified Data.Text.Lazy as L


-- | Trailing space with default attributes deals with bug in VTY
-- where the formatting will continue past the end of chat messages.
-- This adds an extra space if a line doesn't end on the terminal edge.
terminate ::
  Int       {- ^ terminal width  -} ->
  Vty.Image {- ^ unwrapped image -} ->
  Vty.Image {- ^ wrapped image   -}
terminate :: Int -> Image -> Image
terminate Int
n Image
img
  | Image -> Int
Vty.imageWidth Image
img Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Image
img
  | Bool
otherwise               = Image
img Image -> Image -> Image
Vty.<|> Attr -> Char -> Image
Vty.char Attr
defAttr Char
' '


-- | This version of line wrap wraps without regard for word boundaries.
fullLineWrap ::
  Int       {- ^ terminal width  -} ->
  Image'    {- ^ unwrapped image -} ->
  [Image']  {- ^ wrapped image   -}
fullLineWrap :: Int -> Image' -> [Image']
fullLineWrap Int
w Image'
img
  | Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w = [Image'
img]
  | Bool
otherwise = Image'
l Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: Int -> Image' -> [Image']
fullLineWrap Int
w Image'
r
  where
    iw :: Int
iw = Image' -> Int
imageWidth Image'
img
    (Image'
l,Image'
r) = Int -> Image' -> (Image', Image')
splitImage Int
w Image'
img

lineWrapPrefix ::
  Int       {- ^ terminal width  -} ->
  Image'    {- ^ prefix image    -} ->
  Image'    {- ^ unwrapped image -} ->
  [Image']  {- ^ wrapped image   -}
lineWrapPrefix :: Int -> Image' -> Image' -> [Image']
lineWrapPrefix Int
w Image'
pfx Image'
img
  | Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
pfxW Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w = Image'
pfx Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> Char -> Image'
char Attr
defAttr Char
' ' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
x Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
:
                  (Image' -> Image') -> [Image'] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (Image'
padImage' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>) [Image']
xs
  where
    pfxW :: Int
pfxW = Image' -> Int
imageWidth Image'
pfx
    Image'
x:[Image']
xs = Int -> Image' -> [Image']
lineWrap (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pfxW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Image'
img
    pad :: Image'
pad  = Attr -> String -> Image'
string Attr
defAttr (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
pfxW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' ')

-- Don't index when the window is tiny
lineWrapPrefix Int
w Image'
pfx Image'
img = Int -> Image' -> [Image']
lineWrap Int
w (Image'
pfx Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> Char -> Image'
char Attr
defAttr Char
' ' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
img)


lineWrap ::
  Int      {- ^ first line length     -} ->
  Image'   {- ^ image                 -} ->
  [Image'] {- ^ splits                -}
lineWrap :: Int -> Image' -> [Image']
lineWrap Int
w Image'
img
  | Image' -> Int
imageWidth Image'
img Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w = [Image'
img] -- could be empty
  | Bool
otherwise           = Int -> Image' -> [Image']
lineWrap' Int
w Image'
img


lineWrap' ::
  Int      {- ^ first line length     -} ->
  Image'   {- ^ image                 -} ->
  [Image'] {- ^ splits                -}
lineWrap' :: Int -> Image' -> [Image']
lineWrap' Int
w Image'
img
  | Int
imgW Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = []
  | Int
imgW Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w = [Image'
img]
  | Bool
otherwise = Image'
l Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: Int -> Image' -> [Image']
lineWrap' Int
w (Image' -> Image'
dropSpaces Image'
r)
  where
    imgW :: Int
imgW = Image' -> Int
imageWidth Image'
img
    Int
x:[Int]
xs = Image' -> [Int]
splitOptions Image'
img

    (Image'
l,Image'
r) = Int -> Image' -> (Image', Image')
splitImage Int
width Image'
img

    width :: Int
width
      | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w = Int -> [Int] -> Int
go Int
x [Int]
xs
      | Bool
otherwise = Int
w

    go :: Int -> [Int] -> Int
go Int
y [] = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
y Int
w
    go Int
y (Int
z:[Int]
zs)
      | Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w = Int
w
      | Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w = Int
y
      | Bool
otherwise = Int -> [Int] -> Int
go Int
z [Int]
zs


-- | List of image widths suitable for breaking the image on
-- that correspond to word breaks.
splitOptions :: Image' -> [Int]
splitOptions :: Image' -> [Int]
splitOptions
  = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int
0Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==)
  ([Int] -> [Int]) -> (Image' -> [Int]) -> Image' -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> [Int] -> [Int]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 (\Int
x Int
y -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)
  ([Int] -> [Int]) -> (Image' -> [Int]) -> Image' -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
Vty.wcswidth (String -> Int) -> (Text -> String) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
L.unpack)
  ([Text] -> [Int]) -> (Image' -> [Text]) -> Image' -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
L.split (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)
  (Text -> [Text]) -> (Image' -> Text) -> Image' -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image' -> Text
imageText


-- | Drop the leading spaces from an image
dropSpaces :: Image' -> Image'
dropSpaces :: Image' -> Image'
dropSpaces Image'
img
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Image'
img
  | Bool
otherwise = (Image', Image') -> Image'
forall a b. (a, b) -> b
snd (Int -> Image' -> (Image', Image')
splitImage Int
n Image'
img)
  where
    n :: Int
n = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int64
L.length (Text -> Int64) -> Text -> Int64
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
L.takeWhile (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Image' -> Text
imageText Image'
img