{-# 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 txt leftSkip rightClip =
let (toDrop,padPrefix) = clipForCharWidth leftSkip txt 0
txt' = if padPrefix then TL.cons '…' (TL.drop (toDrop+1) txt) else TL.drop toDrop txt
(toTake,padSuffix) = clipForCharWidth rightClip txt' 0
txt'' = TL.append (TL.take toTake txt') (if padSuffix then TL.singleton '…' else TL.empty)
clipForCharWidth w t n
| TL.null t = (n, False)
| w < cw = (n, w /= 0)
| otherwise = clipForCharWidth (w - cw) (TL.tail t) (n + 1)
where cw = safeWcwidth (TL.head t)
in txt''
data Image =
HorizText
{ attr :: Attr
, displayText :: DisplayText
, outputWidth :: Int
, charWidth :: Int
}
| HorizJoin
{ partLeft :: Image
, partRight :: Image
, outputWidth :: Int
, outputHeight :: Int
}
| VertJoin
{ partTop :: Image
, partBottom :: Image
, outputWidth :: Int
, outputHeight :: Int
}
| BGFill
{ outputWidth :: Int
, outputHeight :: Int
}
| CropRight
{ croppedImage :: Image
, outputWidth :: Int
, outputHeight :: Int
}
| CropLeft
{ croppedImage :: Image
, leftSkip :: Int
, outputWidth :: Int
, outputHeight :: Int
}
| CropBottom
{ croppedImage :: Image
, outputWidth :: Int
, outputHeight :: Int
}
| CropTop
{ croppedImage :: Image
, topSkip :: Int
, outputWidth :: Int
, outputHeight :: Int
}
| EmptyImage
deriving (Eq, Generic, Show, Read)
ppImageStructure :: Image -> String
ppImageStructure inImg = go 0 inImg
where
go indent img = tab indent ++ pp indent img
tab indent = concat $ replicate indent " "
pp _ (HorizText {outputWidth}) = "HorizText(" ++ show outputWidth ++ ")"
pp _ (BGFill {outputWidth, outputHeight})
= "BGFill(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")"
pp i (HorizJoin {partLeft = l, partRight = r, outputWidth = c})
= "HorizJoin(" ++ show c ++ ")\n" ++ go (i+1) l ++ "\n" ++ go (i+1) r
pp i (VertJoin {partTop = t, partBottom = b, outputWidth = c, outputHeight = r})
= "VertJoin(" ++ show c ++ ", " ++ show r ++ ")\n"
++ go (i+1) t ++ "\n"
++ go (i+1) b
pp i (CropRight {croppedImage, outputWidth, outputHeight})
= "CropRight(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n"
++ go (i+1) croppedImage
pp i (CropLeft {croppedImage, leftSkip, outputWidth, outputHeight})
= "CropLeft(" ++ show leftSkip ++ "->" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n"
++ go (i+1) croppedImage
pp i (CropBottom {croppedImage, outputWidth, outputHeight})
= "CropBottom(" ++ show outputWidth ++ "," ++ show outputHeight ++ ")\n"
++ go (i+1) croppedImage
pp i (CropTop {croppedImage, topSkip, outputWidth, outputHeight})
= "CropTop("++ show outputWidth ++ "," ++ show topSkip ++ "->" ++ show outputHeight ++ ")\n"
++ go (i+1) croppedImage
pp _ EmptyImage = "EmptyImage"
instance NFData Image where
rnf EmptyImage = ()
rnf (CropRight i w h) = i `deepseq` w `seq` h `seq` ()
rnf (CropLeft i s w h) = i `deepseq` s `seq` w `seq` h `seq` ()
rnf (CropBottom i w h) = i `deepseq` w `seq` h `seq` ()
rnf (CropTop i s w h) = i `deepseq` s `seq` w `seq` h `seq` ()
rnf (BGFill w h) = w `seq` h `seq` ()
rnf (VertJoin t b w h) = t `deepseq` b `deepseq` w `seq` h `seq` ()
rnf (HorizJoin l r w h) = l `deepseq` r `deepseq` w `seq` h `seq` ()
rnf (HorizText a s w cw) = a `seq` s `deepseq` w `seq` cw `seq` ()
imageWidth :: Image -> Int
imageWidth HorizText { outputWidth = w } = w
imageWidth HorizJoin { outputWidth = w } = w
imageWidth VertJoin { outputWidth = w } = w
imageWidth BGFill { outputWidth = w } = w
imageWidth CropRight { outputWidth = w } = w
imageWidth CropLeft { outputWidth = w } = w
imageWidth CropBottom { outputWidth = w } = w
imageWidth CropTop { outputWidth = w } = w
imageWidth EmptyImage = 0
imageHeight :: Image -> Int
imageHeight HorizText {} = 1
imageHeight HorizJoin { outputHeight = h } = h
imageHeight VertJoin { outputHeight = h } = h
imageHeight BGFill { outputHeight = h } = h
imageHeight CropRight { outputHeight = h } = h
imageHeight CropLeft { outputHeight = h } = h
imageHeight CropBottom { outputHeight = h } = h
imageHeight CropTop { outputHeight = h } = h
imageHeight EmptyImage = 0
instance Semigroup Image where
(<>) = vertJoin
instance Monoid Image where
mempty = EmptyImage
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
horizJoin :: Image -> Image -> Image
horizJoin EmptyImage i = i
horizJoin i EmptyImage = i
horizJoin i0@(HorizText a0 t0 w0 cw0) i1@(HorizText a1 t1 w1 cw1)
| a0 == a1 = HorizText a0 (TL.append t0 t1) (w0 + w1) (cw0 + cw1)
| otherwise = HorizJoin i0 i1 (w0 + w1) 1
horizJoin i0 i1
| h0 == h1 = HorizJoin i0 i1 w h0
| h0 < h1
= let padAmount = h1 - h0
in HorizJoin (VertJoin i0 (BGFill w0 padAmount) w0 h1) i1 w h1
| h0 > h1
= let padAmount = h0 - h1
in HorizJoin i0 (VertJoin i1 (BGFill w1 padAmount) w1 h0) w h0
where
w0 = imageWidth i0
w1 = imageWidth i1
w = w0 + w1
h0 = imageHeight i0
h1 = imageHeight i1
horizJoin _ _ = error "horizJoin applied to undefined values."
vertJoin :: Image -> Image -> Image
vertJoin EmptyImage i = i
vertJoin i EmptyImage = i
vertJoin i0 i1
| w0 == w1 = VertJoin i0 i1 w0 h
| w0 < w1
= let padAmount = w1 - w0
in VertJoin (HorizJoin i0 (BGFill padAmount h0) w1 h0) i1 w1 h
| w0 > w1
= let padAmount = w0 - w1
in VertJoin i0 (HorizJoin i1 (BGFill padAmount h1) w0 h1) w0 h
where
w0 = imageWidth i0
w1 = imageWidth i1
h0 = imageHeight i0
h1 = imageHeight i1
h = h0 + h1
vertJoin _ _ = error "vertJoin applied to undefined values."