{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_HADDOCK hide #-}
module Graphics.Vty.Image.Internal where
import Graphics.Vty.Attributes
import Graphics.Text.Width
import GHC.Generics
import Control.DeepSeq
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import qualified Data.Text.Lazy as TL
type DisplayText = TL.Text
clipText :: DisplayText -> Int -> Int -> DisplayText
clipText :: DisplayText -> Int -> Int -> DisplayText
clipText DisplayText
txt Int
leftSkip Int
rightClip =
let (Int64
toDrop,Bool
padPrefix) = Int -> DisplayText -> Int64 -> (Int64, Bool)
forall t. Num t => Int -> DisplayText -> t -> (t, Bool)
clipForCharWidth Int
leftSkip DisplayText
txt Int64
0
txt' :: DisplayText
txt' = if Bool
padPrefix then Char -> DisplayText -> DisplayText
TL.cons Char
'…' (Int64 -> DisplayText -> DisplayText
TL.drop (Int64
toDropInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1) DisplayText
txt) else Int64 -> DisplayText -> DisplayText
TL.drop Int64
toDrop DisplayText
txt
(Int64
toTake,Bool
padSuffix) = Int -> DisplayText -> Int64 -> (Int64, Bool)
forall t. Num t => Int -> DisplayText -> t -> (t, Bool)
clipForCharWidth Int
rightClip DisplayText
txt' Int64
0
txt'' :: DisplayText
txt'' = DisplayText -> DisplayText -> DisplayText
TL.append (Int64 -> DisplayText -> DisplayText
TL.take Int64
toTake DisplayText
txt') (if Bool
padSuffix then Char -> DisplayText
TL.singleton Char
'…' else DisplayText
TL.empty)
clipForCharWidth :: Int -> DisplayText -> t -> (t, Bool)
clipForCharWidth Int
w DisplayText
t t
n
| DisplayText -> Bool
TL.null DisplayText
t = (t
n, Bool
False)
| Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cw = (t
n, Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
| Bool
otherwise = Int -> DisplayText -> t -> (t, Bool)
clipForCharWidth (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cw) (DisplayText -> DisplayText
TL.tail DisplayText
t) (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
where cw :: Int
cw = Char -> Int
safeWcwidth (DisplayText -> Char
TL.head DisplayText
t)
in DisplayText
txt''
data Image =
HorizText
{ Image -> Attr
attr :: Attr
, Image -> DisplayText
displayText :: DisplayText
, Image -> Int
outputWidth :: Int
, Image -> Int
charWidth :: Int
}
| HorizJoin
{ Image -> Image
partLeft :: Image
, Image -> Image
partRight :: Image
, outputWidth :: Int
, Image -> Int
outputHeight :: Int
}
| VertJoin
{ Image -> Image
partTop :: Image
, Image -> Image
partBottom :: Image
, outputWidth :: Int
, outputHeight :: Int
}
| BGFill
{ outputWidth :: Int
, outputHeight :: Int
}
| CropRight
{ Image -> Image
croppedImage :: Image
, outputWidth :: Int
, outputHeight :: Int
}
| CropLeft
{ croppedImage :: Image
, Image -> Int
leftSkip :: Int
, outputWidth :: Int
, outputHeight :: Int
}
| CropBottom
{ croppedImage :: Image
, outputWidth :: Int
, outputHeight :: Int
}
| CropTop
{ croppedImage :: Image
, Image -> Int
topSkip :: Int
, outputWidth :: Int
, outputHeight :: Int
}
| EmptyImage
deriving (Image -> Image -> Bool
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq, (forall x. Image -> Rep Image x)
-> (forall x. Rep Image x -> Image) -> Generic Image
forall x. Rep Image x -> Image
forall x. Image -> Rep Image x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Image x -> Image
$cfrom :: forall x. Image -> Rep Image x
Generic, Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
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, ReadPrec [Image]
ReadPrec Image
Int -> ReadS Image
ReadS [Image]
(Int -> ReadS Image)
-> ReadS [Image]
-> ReadPrec Image
-> ReadPrec [Image]
-> Read Image
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Image]
$creadListPrec :: ReadPrec [Image]
readPrec :: ReadPrec Image
$creadPrec :: ReadPrec Image
readList :: ReadS [Image]
$creadList :: ReadS [Image]
readsPrec :: Int -> ReadS Image
$creadsPrec :: Int -> ReadS Image
Read)
ppImageStructure :: Image -> String
ppImageStructure :: Image -> String
ppImageStructure Image
inImg = Int -> Image -> String
go Int
0 Image
inImg
where
go :: Int -> Image -> String
go Int
indent Image
img = Int -> String
tab Int
indent String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
pp Int
indent Image
img
tab :: Int -> String
tab Int
indent = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
indent String
" "
pp :: Int -> Image -> String
pp Int
_ (HorizText {Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth}) = String
"HorizText(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputWidth String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
pp Int
_ (BGFill {Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
= String
"BGFill(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputWidth String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputHeight String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
pp Int
i (HorizJoin {partLeft :: Image -> Image
partLeft = Image
l, partRight :: Image -> Image
partRight = Image
r, outputWidth :: Image -> Int
outputWidth = Int
c})
= String
"HorizJoin(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
r
pp Int
i (VertJoin {partTop :: Image -> Image
partTop = Image
t, partBottom :: Image -> Image
partBottom = Image
b, outputWidth :: Image -> Int
outputWidth = Int
c, outputHeight :: Image -> Int
outputHeight = Int
r})
= String
"VertJoin(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
b
pp Int
i (CropRight {Image
croppedImage :: Image
croppedImage :: Image -> Image
croppedImage, Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
= String
"CropRight(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputWidth String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputHeight String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
croppedImage
pp Int
i (CropLeft {Image
croppedImage :: Image
croppedImage :: Image -> Image
croppedImage, Int
leftSkip :: Int
leftSkip :: Image -> Int
leftSkip, Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
= String
"CropLeft(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
leftSkip String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"->" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputWidth String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputHeight String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
croppedImage
pp Int
i (CropBottom {Image
croppedImage :: Image
croppedImage :: Image -> Image
croppedImage, Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
= String
"CropBottom(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputWidth String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputHeight String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
croppedImage
pp Int
i (CropTop {Image
croppedImage :: Image
croppedImage :: Image -> Image
croppedImage, Int
topSkip :: Int
topSkip :: Image -> Int
topSkip, Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
= String
"CropTop("String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputWidth String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
topSkip String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"->" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputHeight String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
croppedImage
pp Int
_ Image
EmptyImage = String
"EmptyImage"
instance NFData Image where
rnf :: Image -> ()
rnf Image
EmptyImage = ()
rnf (CropRight Image
i Int
w Int
h) = Image
i Image -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
rnf (CropLeft Image
i Int
s Int
w Int
h) = Image
i Image -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
s Int -> () -> ()
`seq` Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
rnf (CropBottom Image
i Int
w Int
h) = Image
i Image -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
rnf (CropTop Image
i Int
s Int
w Int
h) = Image
i Image -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
s Int -> () -> ()
`seq` Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
rnf (BGFill Int
w Int
h) = Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
rnf (VertJoin Image
t Image
b Int
w Int
h) = Image
t Image -> Image -> Image
forall a b. NFData a => a -> b -> b
`deepseq` Image
b Image -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
rnf (HorizJoin Image
l Image
r Int
w Int
h) = Image
l Image -> Image -> Image
forall a b. NFData a => a -> b -> b
`deepseq` Image
r Image -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
rnf (HorizText Attr
a DisplayText
s Int
w Int
cw) = Attr
a Attr -> () -> ()
`seq` DisplayText
s DisplayText -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
w Int -> () -> ()
`seq` Int
cw Int -> () -> ()
`seq` ()
imageWidth :: Image -> Int
imageWidth :: Image -> Int
imageWidth HorizText { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth HorizJoin { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth VertJoin { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth BGFill { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth CropRight { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth CropLeft { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth CropBottom { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth CropTop { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth Image
EmptyImage = Int
0
imageHeight :: Image -> Int
imageHeight :: Image -> Int
imageHeight HorizText {} = Int
1
imageHeight HorizJoin { outputHeight :: Image -> Int
outputHeight = Int
h } = Int
h
imageHeight VertJoin { outputHeight :: Image -> Int
outputHeight = Int
h } = Int
h
imageHeight BGFill { outputHeight :: Image -> Int
outputHeight = Int
h } = Int
h
imageHeight CropRight { outputHeight :: Image -> Int
outputHeight = Int
h } = Int
h
imageHeight CropLeft { outputHeight :: Image -> Int
outputHeight = Int
h } = Int
h
imageHeight CropBottom { outputHeight :: Image -> Int
outputHeight = Int
h } = Int
h
imageHeight CropTop { outputHeight :: Image -> Int
outputHeight = Int
h } = Int
h
imageHeight Image
EmptyImage = Int
0
instance Semigroup Image where
<> :: Image -> Image -> Image
(<>) = Image -> Image -> Image
vertJoin
instance Monoid Image where
mempty :: Image
mempty = Image
EmptyImage
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
horizJoin :: Image -> Image -> Image
horizJoin :: Image -> Image -> Image
horizJoin Image
EmptyImage Image
i = Image
i
horizJoin Image
i Image
EmptyImage = Image
i
horizJoin i0 :: Image
i0@(HorizText Attr
a0 DisplayText
t0 Int
w0 Int
cw0) i1 :: Image
i1@(HorizText Attr
a1 DisplayText
t1 Int
w1 Int
cw1)
| Attr
a0 Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
a1 = Attr -> DisplayText -> Int -> Int -> Image
HorizText Attr
a0 (DisplayText -> DisplayText -> DisplayText
TL.append DisplayText
t0 DisplayText
t1) (Int
w0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w1) (Int
cw0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cw1)
| Bool
otherwise = Image -> Image -> Int -> Int -> Image
HorizJoin Image
i0 Image
i1 (Int
w0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w1) Int
1
horizJoin Image
i0 Image
i1
| Int
h0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
h1 = Image -> Image -> Int -> Int -> Image
HorizJoin Image
i0 Image
i1 Int
w Int
h0
| Int
h0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h1
= let padAmount :: Int
padAmount = Int
h1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h0
in Image -> Image -> Int -> Int -> Image
HorizJoin (Image -> Image -> Int -> Int -> Image
VertJoin Image
i0 (Int -> Int -> Image
BGFill Int
w0 Int
padAmount) Int
w0 Int
h1) Image
i1 Int
w Int
h1
| Int
h0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
h1
= let padAmount :: Int
padAmount = Int
h0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h1
in Image -> Image -> Int -> Int -> Image
HorizJoin Image
i0 (Image -> Image -> Int -> Int -> Image
VertJoin Image
i1 (Int -> Int -> Image
BGFill Int
w1 Int
padAmount) Int
w1 Int
h0) Int
w Int
h0
where
w0 :: Int
w0 = Image -> Int
imageWidth Image
i0
w1 :: Int
w1 = Image -> Int
imageWidth Image
i1
w :: Int
w = Int
w0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w1
h0 :: Int
h0 = Image -> Int
imageHeight Image
i0
h1 :: Int
h1 = Image -> Int
imageHeight Image
i1
horizJoin Image
_ Image
_ = String -> Image
forall a. HasCallStack => String -> a
error String
"horizJoin applied to undefined values."
vertJoin :: Image -> Image -> Image
vertJoin :: Image -> Image -> Image
vertJoin Image
EmptyImage Image
i = Image
i
vertJoin Image
i Image
EmptyImage = Image
i
vertJoin Image
i0 Image
i1
| Int
w0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w1 = Image -> Image -> Int -> Int -> Image
VertJoin Image
i0 Image
i1 Int
w0 Int
h
| Int
w0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w1
= let padAmount :: Int
padAmount = Int
w1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w0
in Image -> Image -> Int -> Int -> Image
VertJoin (Image -> Image -> Int -> Int -> Image
HorizJoin Image
i0 (Int -> Int -> Image
BGFill Int
padAmount Int
h0) Int
w1 Int
h0) Image
i1 Int
w1 Int
h
| Int
w0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w1
= let padAmount :: Int
padAmount = Int
w0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w1
in Image -> Image -> Int -> Int -> Image
VertJoin Image
i0 (Image -> Image -> Int -> Int -> Image
HorizJoin Image
i1 (Int -> Int -> Image
BGFill Int
padAmount Int
h1) Int
w0 Int
h1) Int
w0 Int
h
where
w0 :: Int
w0 = Image -> Int
imageWidth Image
i0
w1 :: Int
w1 = Image -> Int
imageWidth Image
i1
h0 :: Int
h0 = Image -> Int
imageHeight Image
i0
h1 :: Int
h1 = Image -> Int
imageHeight Image
i1
h :: Int
h = Int
h0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h1
vertJoin Image
_ Image
_ = String -> Image
forall a. HasCallStack => String -> a
error String
"vertJoin applied to undefined values."