{-# 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) = 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
toDropforall a. Num a => a -> a -> a
+Int64
1) DisplayText
txt) else Int64 -> DisplayText -> DisplayText
TL.drop Int64
toDrop DisplayText
txt
(Int64
toTake,Bool
padSuffix) = 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 forall a. Ord a => a -> a -> Bool
< Int
cw = (t
n, Int
w forall a. Eq a => a -> a -> Bool
/= Int
0)
| Bool
otherwise = Int -> DisplayText -> t -> (t, Bool)
clipForCharWidth (Int
w forall a. Num a => a -> a -> a
- Int
cw) (DisplayText -> DisplayText
TL.tail DisplayText
t) (t
n 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
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. 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
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]
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 = Int -> Image -> String
go Int
0
where
go :: Int -> Image -> String
go Int
indent Image
img = Int -> String
tab Int
indent forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
pp Int
indent Image
img
tab :: Int -> String
tab Int
indent = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ 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(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputWidth 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(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputWidth forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputHeight 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(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
c forall a. [a] -> [a] -> [a]
++ String
")\n" forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall a. Num a => a -> a -> a
+Int
1) Image
l forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall 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(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
c forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
r forall a. [a] -> [a] -> [a]
++ String
")\n"
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall a. Num a => a -> a -> a
+Int
1) Image
t forall a. [a] -> [a] -> [a]
++ String
"\n"
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall 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(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputWidth forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputHeight forall a. [a] -> [a] -> [a]
++ String
")\n"
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall 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(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
leftSkip forall a. [a] -> [a] -> [a]
++ String
"->" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputWidth forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputHeight forall a. [a] -> [a] -> [a]
++ String
")\n"
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall 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(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputWidth forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputHeight forall a. [a] -> [a] -> [a]
++ String
")\n"
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall 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("forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputWidth forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
topSkip forall a. [a] -> [a] -> [a]
++ String
"->" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputHeight forall a. [a] -> [a] -> [a]
++ String
")\n"
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall 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 forall a b. NFData a => a -> b -> b
`deepseq` Int
w seq :: forall a b. a -> b -> b
`seq` Int
h seq :: forall a b. a -> b -> b
`seq` ()
rnf (CropLeft Image
i Int
s Int
w Int
h) = Image
i forall a b. NFData a => a -> b -> b
`deepseq` Int
s seq :: forall a b. a -> b -> b
`seq` Int
w seq :: forall a b. a -> b -> b
`seq` Int
h seq :: forall a b. a -> b -> b
`seq` ()
rnf (CropBottom Image
i Int
w Int
h) = Image
i forall a b. NFData a => a -> b -> b
`deepseq` Int
w seq :: forall a b. a -> b -> b
`seq` Int
h seq :: forall a b. a -> b -> b
`seq` ()
rnf (CropTop Image
i Int
s Int
w Int
h) = Image
i forall a b. NFData a => a -> b -> b
`deepseq` Int
s seq :: forall a b. a -> b -> b
`seq` Int
w seq :: forall a b. a -> b -> b
`seq` Int
h seq :: forall a b. a -> b -> b
`seq` ()
rnf (BGFill Int
w Int
h) = Int
w seq :: forall a b. a -> b -> b
`seq` Int
h seq :: forall a b. a -> b -> b
`seq` ()
rnf (VertJoin Image
t Image
b Int
w Int
h) = Image
t forall a b. NFData a => a -> b -> b
`deepseq` Image
b forall a b. NFData a => a -> b -> b
`deepseq` Int
w seq :: forall a b. a -> b -> b
`seq` Int
h seq :: forall a b. a -> b -> b
`seq` ()
rnf (HorizJoin Image
l Image
r Int
w Int
h) = Image
l forall a b. NFData a => a -> b -> b
`deepseq` Image
r forall a b. NFData a => a -> b -> b
`deepseq` Int
w seq :: forall a b. a -> b -> b
`seq` Int
h seq :: forall a b. a -> b -> b
`seq` ()
rnf (HorizText Attr
a DisplayText
s Int
w Int
cw) = Attr
a seq :: forall a b. a -> b -> b
`seq` DisplayText
s forall a b. NFData a => a -> b -> b
`deepseq` Int
w seq :: forall a b. a -> b -> b
`seq` Int
cw seq :: forall a b. a -> b -> b
`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 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 forall a. Num a => a -> a -> a
+ Int
w1) (Int
cw0 forall a. Num a => a -> a -> a
+ Int
cw1)
| Bool
otherwise = Image -> Image -> Int -> Int -> Image
HorizJoin Image
i0 Image
i1 (Int
w0 forall a. Num a => a -> a -> a
+ Int
w1) Int
1
horizJoin Image
i0 Image
i1
| Int
h0 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 forall a. Ord a => a -> a -> Bool
< Int
h1
= let padAmount :: Int
padAmount = Int
h1 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 forall a. Ord a => a -> a -> Bool
> Int
h1
= let padAmount :: Int
padAmount = Int
h0 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 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
_ = 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 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 forall a. Ord a => a -> a -> Bool
< Int
w1
= let padAmount :: Int
padAmount = Int
w1 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 forall a. Ord a => a -> a -> Bool
> Int
w1
= let padAmount :: Int
padAmount = Int
w0 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 forall a. Num a => a -> a -> a
+ Int
h1
vertJoin Image
_ Image
_ = forall a. HasCallStack => String -> a
error String
"vertJoin applied to undefined values."