{-# Language OverloadedStrings #-}
{-|
Module      : Client.Image.PackedImage
Description : Packed vty Image type
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides a more memory efficient way to store images.

-}
module Client.Image.PackedImage
  ( Image'
  , unpackImage

  -- * Packed image construction
  , char
  , text'
  , string
  , imageWidth
  , splitImage
  , imageText
  , resizeImage
  ) where

import Data.List (findIndex)
import Data.String (IsString(..))
import Data.Text qualified as S
import Data.Text.Lazy qualified as L
import Graphics.Vty.Attributes (Attr, defAttr)
import Graphics.Vty.Image ((<|>), wcswidth, wcwidth)
import Graphics.Vty.Image.Internal (Image(..))


unpackImage :: Image' -> Image
unpackImage :: Image' -> Image
unpackImage Image'
i =
  case Image'
i of
    Image'
EmptyImage'          -> Image
EmptyImage
    HorizText' Attr
a Text
b Int
c Int
d Image'
e -> Attr -> Text -> Int -> Int -> Image
HorizText Attr
a (Text -> Text
L.fromStrict Text
b) Int
c Int
d Image -> Image -> Image
<|> Image' -> Image
unpackImage Image'
e


-- | Packed, strict version of 'Image' used for long-term storage of images.
data Image'
  = HorizText'
      !Attr -- don't unpack, these get reused from the palette
      {-# UNPACK #-} !S.Text
      {-# UNPACK #-} !Int -- terminal width
      {-# UNPACK #-} !Int -- codepoint count
      !Image'
  | EmptyImage'
  deriving (Int -> Image' -> ShowS
[Image'] -> ShowS
Image' -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image'] -> ShowS
$cshowList :: [Image'] -> ShowS
show :: Image' -> String
$cshow :: Image' -> String
showsPrec :: Int -> Image' -> ShowS
$cshowsPrec :: Int -> Image' -> ShowS
Show)

instance Monoid Image' where
  mempty :: Image'
mempty  = Image'
EmptyImage'
  mappend :: Image' -> Image' -> Image'
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup Image' where
  -- maintain compressed form
  HorizText' Attr
a Text
b Int
c Int
d Image'
EmptyImage' <> :: Image' -> Image' -> Image'
<> HorizText' Attr
a' Text
b' Int
c' Int
d' Image'
rest
    | Attr
a forall a. Eq a => a -> a -> Bool
== Attr
a' = Attr -> Text -> Int -> Int -> Image' -> Image'
HorizText' Attr
a (Text
b forall a. Semigroup a => a -> a -> a
<> Text
b') (Int
c forall a. Num a => a -> a -> a
+ Int
c') (Int
d forall a. Num a => a -> a -> a
+ Int
d') Image'
rest

  Image'
EmptyImage'          <> Image'
y = Image'
y
  HorizText' Attr
a Text
b Int
c Int
d Image'
e <> Image'
y = Attr -> Text -> Int -> Int -> Image' -> Image'
HorizText' Attr
a Text
b Int
c Int
d (Image'
e forall a. Semigroup a => a -> a -> a
<> Image'
y)

instance IsString Image' where fromString :: String -> Image'
fromString = Attr -> String -> Image'
string Attr
defAttr

text' :: Attr -> S.Text -> Image'
text' :: Attr -> Text -> Image'
text' Attr
a Text
s
  | Text -> Bool
S.null Text
s  = Image'
EmptyImage'
  | Bool
otherwise = Attr -> Text -> Int -> Int -> Image' -> Image'
HorizText' Attr
a Text
s (String -> Int
wcswidth (Text -> String
S.unpack Text
s)) (Text -> Int
S.length Text
s) Image'
EmptyImage'

char :: Attr -> Char -> Image'
char :: Attr -> Char -> Image'
char Attr
a Char
c = Attr -> Text -> Int -> Int -> Image' -> Image'
HorizText' Attr
a (Char -> Text
S.singleton Char
c) (Char -> Int
wcwidth Char
c) Int
1 Image'
EmptyImage'

string :: Attr -> String -> Image'
string :: Attr -> String -> Image'
string Attr
a String
s
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s    = Image'
EmptyImage'
  | Bool
otherwise = Attr -> Text -> Int -> Int -> Image' -> Image'
HorizText' Attr
a Text
t (String -> Int
wcswidth String
s) (Text -> Int
S.length Text
t) Image'
EmptyImage'
  where t :: Text
t = String -> Text
S.pack String
s

splitImage :: Int {- ^ image width -} -> Image' -> (Image',Image')
splitImage :: Int -> Image' -> (Image', Image')
splitImage Int
_ Image'
EmptyImage' = (Image'
EmptyImage', Image'
EmptyImage')
splitImage Int
w (HorizText' Attr
a Text
t Int
w' Int
l Image'
rest)
  | Int
w forall a. Ord a => a -> a -> Bool
>= Int
w' = case Int -> Image' -> (Image', Image')
splitImage (Int
wforall a. Num a => a -> a -> a
-Int
w') Image'
rest of
                (Image'
x,Image'
y) -> (Attr -> Text -> Int -> Int -> Image' -> Image'
HorizText' Attr
a Text
t Int
w' Int
l Image'
x, Image'
y)
  | Bool
otherwise = (Attr -> Text -> Image'
text' Attr
a (Int -> Text -> Text
S.take Int
i Text
t), Attr -> Text -> Image'
text' Attr
a (Int -> Text -> Text
S.drop Int
i Text
t) forall a. Semigroup a => a -> a -> a
<> Image'
rest)
  where
    ws :: [Int]
ws = forall a. (a -> a -> a) -> [a] -> [a]
scanl1 forall a. Num a => a -> a -> a
(+) (forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
wcwidth (Text -> String
S.unpack Text
t))
    i :: Int
i  = case forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (forall a. Ord a => a -> a -> Bool
> Int
w) [Int]
ws of
           Maybe Int
Nothing -> Int
0
           Just Int
ix -> Int
ix

-- | Width in terms of terminal columns
imageWidth :: Image' -> Int
imageWidth :: Image' -> Int
imageWidth = Int -> Image' -> Int
go Int
0
  where
    go :: Int -> Image' -> Int
go Int
acc Image'
EmptyImage'            = Int
acc
    go Int
acc (HorizText' Attr
_ Text
_ Int
w Int
_ Image'
x) = Int -> Image' -> Int
go (Int
acc forall a. Num a => a -> a -> a
+ Int
w) Image'
x

imageText :: Image' -> L.Text
imageText :: Image' -> Text
imageText = [Text] -> Text
L.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image' -> [Text]
go
  where
    go :: Image' -> [Text]
go Image'
EmptyImage' = []
    go (HorizText' Attr
_ Text
t Int
_ Int
_ Image'
xs) = Text
t forall a. a -> [a] -> [a]
: Image' -> [Text]
go Image'
xs

resizeImage :: Int -> Image' -> Image'
resizeImage :: Int -> Image' -> Image'
resizeImage Int
w Image'
img =
  let iw :: Int
iw = Image' -> Int
imageWidth Image'
img in
  case forall a. Ord a => a -> a -> Ordering
compare Int
w Int
iw of
    Ordering
LT -> forall a b. (a, b) -> a
fst (Int -> Image' -> (Image', Image')
splitImage Int
w Image'
img)
    Ordering
EQ -> Image'
img
    Ordering
GT -> Image'
img forall a. Semigroup a => a -> a -> a
<> Attr -> String -> Image'
string Attr
defAttr (forall a. Int -> a -> [a]
replicate (Int
wforall a. Num a => a -> a -> a
-Int
iw) Char
' ')