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