{-|
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 (char, imageText, imageWidth, splitImage, string, Image')
import Graphics.Vty.Image qualified as Vty
import Graphics.Vty.Attributes (defAttr)
import Data.Text.Lazy qualified 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 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 forall a. Ord a => a -> a -> Bool
<= Int
w = [Image'
img]
  | Bool
otherwise = Image'
l 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
3forall a. Num a => a -> a -> a
*Int
pfxW forall a. Ord a => a -> a -> Bool
<= Int
w = Image'
pfx forall a. Semigroup a => a -> a -> a
<> Attr -> Char -> Image'
char Attr
defAttr Char
' ' forall a. Semigroup a => a -> a -> a
<> Image'
x forall a. a -> [a] -> [a]
:
                  forall a b. (a -> b) -> [a] -> [b]
map (Image'
padforall 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 forall a. Num a => a -> a -> a
- Int
pfxW forall a. Num a => a -> a -> a
- Int
1) Image'
img
    pad :: Image'
pad  = Attr -> String -> Image'
string Attr
defAttr (forall a. Int -> a -> [a]
replicate (Int
pfxW 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 forall a. Semigroup a => a -> a -> a
<> Attr -> Char -> Image'
char Attr
defAttr Char
' ' 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 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 forall a. Eq a => a -> a -> Bool
== Int
0 = []
  | Int
imgW forall a. Ord a => a -> a -> Bool
<= Int
w = [Image'
img]
  | Bool
otherwise = Image'
l 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 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 [] = forall a. Ord a => a -> a -> a
min Int
y Int
w
    go Int
y (Int
z:[Int]
zs)
      | Int
zforall a. Num a => a -> a -> a
-Int
y forall a. Ord a => a -> a -> Bool
> Int
w = Int
w
      | Int
z 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
  = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int
0forall a. Eq a => a -> a -> Bool
==)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> [a] -> [a]
scanl1 (\Int
x Int
y -> Int
1 forall a. Num a => a -> a -> a
+ Int
x forall a. Num a => a -> a -> a
+ Int
y)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
Vty.wcswidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
L.unpack)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
L.split (Char
' 'forall a. Eq a => a -> a -> Bool
==)
  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 forall a. Eq a => a -> a -> Bool
== Int
0    = Image'
img
  | Bool
otherwise = forall a b. (a, b) -> b
snd (Int -> Image' -> (Image', Image')
splitImage Int
n Image'
img)
  where
    n :: Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Text -> Int64
L.length forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
L.takeWhile (Char
' 'forall a. Eq a => a -> a -> Bool
==) forall a b. (a -> b) -> a -> b
$ Image' -> Text
imageText Image'
img