{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Sixel
( module Data.Sixel,
LatexStr (..),
latex,
math,
)
where
import Codec.Picture
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Internal as B
import Data.Char (chr)
import Data.Sixel.Internal
import qualified Data.Vector.Storable as V
import Data.Word (Word8)
import Foreign.C.String
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Ptr
import System.IO.Temp (withSystemTempDirectory)
import System.IO.Unsafe (unsafePerformIO)
import System.Process (readProcessWithExitCode)
newtype SixelImage = SixelImage {SixelImage -> String
toSixelString :: String} deriving (SixelImage -> SixelImage -> Bool
(SixelImage -> SixelImage -> Bool)
-> (SixelImage -> SixelImage -> Bool) -> Eq SixelImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SixelImage -> SixelImage -> Bool
== :: SixelImage -> SixelImage -> Bool
$c/= :: SixelImage -> SixelImage -> Bool
/= :: SixelImage -> SixelImage -> Bool
Eq)
instance Show SixelImage where
show :: SixelImage -> String
show (SixelImage String
img) = String
img
instance Show LatexStr where
show :: LatexStr -> String
show LatexStr
str = SixelImage -> String
forall a. Show a => a -> String
show (SixelImage -> String) -> SixelImage -> String
forall a b. (a -> b) -> a -> b
$ LatexStr -> SixelImage
forall a. ToSixel a => a -> SixelImage
toSixel LatexStr
str
type ColorNumber = Word8
type PixelPattern = Word8
type Width = Int
type Height = Int
data SixelCmd
= Start Int Int Int
| End
| Size Int Int Width Height
| ColorMapRGB ColorNumber Word8 Word8 Word8
| ColorMapHLS ColorNumber Int Word8 Word8
| Color ColorNumber
| Sixel PixelPattern
| Repeat Int PixelPattern
| CR
| LF
deriving (SixelCmd -> SixelCmd -> Bool
(SixelCmd -> SixelCmd -> Bool)
-> (SixelCmd -> SixelCmd -> Bool) -> Eq SixelCmd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SixelCmd -> SixelCmd -> Bool
== :: SixelCmd -> SixelCmd -> Bool
$c/= :: SixelCmd -> SixelCmd -> Bool
/= :: SixelCmd -> SixelCmd -> Bool
Eq)
instance Show SixelCmd where
show :: SixelCmd -> String
show = \case
(Start Int
p1 Int
p2 Int
p3) -> String
"\ESCP" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
p1 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
p2 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
p3 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"q"
SixelCmd
End -> String
"\ESC\\"
(Size Int
pan Int
pad Int
width Int
height) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"\"", Int -> String
forall a. Show a => a -> String
show Int
pan, String
";", Int -> String
forall a. Show a => a -> String
show Int
pad, String
";", Int -> String
forall a. Show a => a -> String
show Int
width, String
";", Int -> String
forall a. Show a => a -> String
show Int
height]
(ColorMapRGB ColorNumber
number ColorNumber
x ColorNumber
y ColorNumber
z) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"#", ColorNumber -> String
forall a. Show a => a -> String
show ColorNumber
number, String
";2;", ColorNumber -> String
forall a. Show a => a -> String
show ColorNumber
x, String
";", ColorNumber -> String
forall a. Show a => a -> String
show ColorNumber
y, String
";", ColorNumber -> String
forall a. Show a => a -> String
show ColorNumber
z]
(ColorMapHLS ColorNumber
number Int
h ColorNumber
l ColorNumber
s) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"#", ColorNumber -> String
forall a. Show a => a -> String
show ColorNumber
number, String
";1;", Int -> String
forall a. Show a => a -> String
show Int
h, String
";", ColorNumber -> String
forall a. Show a => a -> String
show ColorNumber
l, String
";", ColorNumber -> String
forall a. Show a => a -> String
show ColorNumber
s]
(Color ColorNumber
number) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"#", ColorNumber -> String
forall a. Show a => a -> String
show ColorNumber
number]
(Sixel ColorNumber
pat) -> [Int -> Char
chr (ColorNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ColorNumber
pat Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x3f)]
(Repeat Int
num ColorNumber
pat) -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"!", Int -> String
forall a. Show a => a -> String
show Int
num, [Int -> Char
chr (ColorNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ColorNumber
pat Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x3f)]]
SixelCmd
CR -> String
"$"
SixelCmd
LF -> String
"-"
instance {-# OVERLAPS #-} Show [SixelCmd] where
show :: [SixelCmd] -> String
show [SixelCmd]
xs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (SixelCmd -> String) -> [SixelCmd] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SixelCmd -> String
forall a. Show a => a -> String
show [SixelCmd]
xs
class ToSixel a where
toSixel :: a -> SixelImage
putSixel :: a -> IO ()
instance {-# OVERLAPS #-} (Show a) => ToSixel a where
toSixel :: a -> SixelImage
toSixel a
xs = String -> SixelImage
SixelImage (String -> SixelImage) -> String -> SixelImage
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
xs
putSixel :: a -> IO ()
putSixel a
xs = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
xs
instance {-# OVERLAPS #-} ToSixel [SixelCmd] where
toSixel :: [SixelCmd] -> SixelImage
toSixel [SixelCmd]
xs = String -> SixelImage
SixelImage ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (SixelCmd -> String) -> [SixelCmd] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SixelCmd -> String
forall a. Show a => a -> String
show [SixelCmd]
xs)
putSixel :: [SixelCmd] -> IO ()
putSixel [SixelCmd]
xs = String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (SixelCmd -> String) -> [SixelCmd] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SixelCmd -> String
forall a. Show a => a -> String
show [SixelCmd]
xs
instance {-# OVERLAPS #-} ToSixel DynamicImage where
toSixel :: DynamicImage -> SixelImage
toSixel DynamicImage
dimg = Image PixelRGB8 -> SixelImage
forall a. ToSixel a => a -> SixelImage
toSixel (Image PixelRGB8 -> SixelImage) -> Image PixelRGB8 -> SixelImage
forall a b. (a -> b) -> a -> b
$ DynamicImage -> Image PixelRGB8
convertRGB8 DynamicImage
dimg
putSixel :: DynamicImage -> IO ()
putSixel DynamicImage
img = Image PixelRGB8 -> IO ()
forall a. ToSixel a => a -> IO ()
putSixel (Image PixelRGB8 -> IO ()) -> Image PixelRGB8 -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicImage -> Image PixelRGB8
convertRGB8 DynamicImage
img
instance {-# OVERLAPS #-} ToSixel (Image PixelRGB8) where
toSixel :: Image PixelRGB8 -> SixelImage
toSixel Image PixelRGB8
img = String -> SixelImage
SixelImage (ByteString -> String
BC.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> ByteString
img2palettizedSixel Image PixelRGB8
img)
putSixel :: Image PixelRGB8 -> IO ()
putSixel Image PixelRGB8
img = ByteString -> IO ()
BC.putStr (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> ByteString
img2palettizedSixel Image PixelRGB8
img
instance {-# OVERLAPS #-} ToSixel SixelImage where
toSixel :: SixelImage -> SixelImage
toSixel = SixelImage -> SixelImage
forall a. a -> a
id
putSixel :: SixelImage -> IO ()
putSixel SixelImage
img = String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SixelImage -> String
forall a. Show a => a -> String
show SixelImage
img
instance ToSixel LatexStr where
toSixel :: LatexStr -> SixelImage
toSixel LatexStr
str = IO SixelImage -> SixelImage
forall a. IO a -> a
unsafePerformIO (IO SixelImage -> SixelImage) -> IO SixelImage -> SixelImage
forall a b. (a -> b) -> a -> b
$ do
LatexStr -> IO (Either String DynamicImage)
latex2img LatexStr
str IO (Either String DynamicImage)
-> (Either String DynamicImage -> IO SixelImage) -> IO SixelImage
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left String
err -> String -> IO SixelImage
forall a. HasCallStack => String -> a
error String
err
Right DynamicImage
img -> SixelImage -> IO SixelImage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SixelImage -> IO SixelImage) -> SixelImage -> IO SixelImage
forall a b. (a -> b) -> a -> b
$ DynamicImage -> SixelImage
forall a. ToSixel a => a -> SixelImage
toSixel DynamicImage
img
putSixel :: LatexStr -> IO ()
putSixel LatexStr
img = String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SixelImage -> String
forall a. Show a => a -> String
show (SixelImage -> String) -> SixelImage -> String
forall a b. (a -> b) -> a -> b
$ LatexStr -> SixelImage
forall a. ToSixel a => a -> SixelImage
toSixel LatexStr
img
toSixelCmds :: Image PixelRGB8 -> [SixelCmd]
toSixelCmds :: Image PixelRGB8 -> [SixelCmd]
toSixelCmds Image PixelRGB8
img =
let width :: Int
width = Image PixelRGB8 -> Int
forall a. Image a -> Int
imageWidth Image PixelRGB8
img Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
height :: Int
height = Image PixelRGB8 -> Int
forall a. Image a -> Int
imageHeight Image PixelRGB8
img Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
header :: [SixelCmd]
header =
[ Int -> Int -> Int -> SixelCmd
Start Int
8 Int
1 Int
0,
Int -> Int -> Int -> Int -> SixelCmd
Size Int
1 Int
1 Int
width Int
height,
ColorNumber
-> ColorNumber -> ColorNumber -> ColorNumber -> SixelCmd
ColorMapRGB ColorNumber
0 ColorNumber
100 ColorNumber
100 ColorNumber
100,
ColorNumber -> SixelCmd
Color ColorNumber
0
]
footer :: SixelCmd
footer = SixelCmd
End
putSixel :: a -> SixelCmd
putSixel a
j = case a
j a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
6 of
a
0 -> ColorNumber -> SixelCmd
Sixel ColorNumber
1
a
1 -> ColorNumber -> SixelCmd
Sixel ColorNumber
2
a
2 -> ColorNumber -> SixelCmd
Sixel ColorNumber
4
a
3 -> ColorNumber -> SixelCmd
Sixel ColorNumber
8
a
4 -> ColorNumber -> SixelCmd
Sixel ColorNumber
16
a
5 -> ColorNumber -> SixelCmd
Sixel ColorNumber
32
pixels :: [SixelCmd]
pixels =
[[SixelCmd]] -> [SixelCmd]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [SixelCmd]
header,
[[SixelCmd]] -> [SixelCmd]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
( ((Int -> [SixelCmd]) -> [Int] -> [[SixelCmd]])
-> [Int] -> (Int -> [SixelCmd]) -> [[SixelCmd]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> [SixelCmd]) -> [Int] -> [[SixelCmd]]
forall a b. (a -> b) -> [a] -> [b]
map [Int
0 .. (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)] ((Int -> [SixelCmd]) -> [[SixelCmd]])
-> (Int -> [SixelCmd]) -> [[SixelCmd]]
forall a b. (a -> b) -> a -> b
$ \Int
j ->
[[SixelCmd]] -> [SixelCmd]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [[SixelCmd]] -> [SixelCmd]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
( ((Int -> [SixelCmd]) -> [Int] -> [[SixelCmd]])
-> [Int] -> (Int -> [SixelCmd]) -> [[SixelCmd]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> [SixelCmd]) -> [Int] -> [[SixelCmd]]
forall a b. (a -> b) -> [a] -> [b]
map [Int
0 .. (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)] ((Int -> [SixelCmd]) -> [[SixelCmd]])
-> (Int -> [SixelCmd]) -> [[SixelCmd]]
forall a b. (a -> b) -> a -> b
$ \Int
i ->
[ Image PixelRGB8 -> Int -> Int -> SixelCmd
pixel2colorMap Image PixelRGB8
img Int
i Int
j,
Int -> SixelCmd
forall {a}. Integral a => a -> SixelCmd
putSixel Int
j
]
),
if (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
6) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 then [SixelCmd
LF] else [SixelCmd
CR]
]
),
[SixelCmd
footer]
]
in [SixelCmd]
pixels
where
pixel2colorMap :: Image PixelRGB8 -> Int -> Int -> SixelCmd
pixel2colorMap :: Image PixelRGB8 -> Int -> Int -> SixelCmd
pixel2colorMap Image PixelRGB8
img Int
i Int
j =
let p :: PixelRGB8
p@(PixelRGB8 ColorNumber
r ColorNumber
g ColorNumber
b) = Image PixelRGB8 -> Int -> Int -> PixelRGB8
forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image PixelRGB8
img Int
i Int
j
rr :: ColorNumber
rr = Int -> ColorNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ColorNumber) -> Int -> ColorNumber
forall a b. (a -> b) -> a -> b
$ ((ColorNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ColorNumber
r :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
101) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
256
gg :: ColorNumber
gg = Int -> ColorNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ColorNumber) -> Int -> ColorNumber
forall a b. (a -> b) -> a -> b
$ ((ColorNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ColorNumber
g :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
101) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
256
bb :: ColorNumber
bb = Int -> ColorNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ColorNumber) -> Int -> ColorNumber
forall a b. (a -> b) -> a -> b
$ ((ColorNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ColorNumber
b :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
101) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
256
in ColorNumber
-> ColorNumber -> ColorNumber -> ColorNumber -> SixelCmd
ColorMapRGB ColorNumber
0 ColorNumber
rr ColorNumber
gg ColorNumber
bb
img2sixel :: Image PixelRGB8 -> ByteString
img2sixel :: Image PixelRGB8 -> ByteString
img2sixel Image PixelRGB8
img = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
let (Image Int
w Int
h Vector (PixelBaseComponent PixelRGB8)
vec) = Image PixelRGB8
img
bsize <- CInt -> CInt -> IO CInt
c_bufsize (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
let (sptr, _) = V.unsafeToForeignPtr0 vec
B.createAndTrim (fromIntegral bsize) $ \Ptr ColorNumber
dst -> do
ForeignPtr ColorNumber -> (Ptr ColorNumber -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ColorNumber
sptr ((Ptr ColorNumber -> IO Int) -> IO Int)
-> (Ptr ColorNumber -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr ColorNumber
src -> do
len <- Ptr () -> Ptr () -> CInt -> CInt -> IO CInt
c_img2sixel (Ptr ColorNumber -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ColorNumber
dst) (Ptr ColorNumber -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ColorNumber
src) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
return (fromIntegral len)
img2palettizedSixel :: Image PixelRGB8 -> ByteString
img2palettizedSixel :: Image PixelRGB8 -> ByteString
img2palettizedSixel Image PixelRGB8
img = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
let (Image ColorNumber
img',Image PixelRGB8
palette) = PaletteOptions
-> Image PixelRGB8 -> (Image ColorNumber, Image PixelRGB8)
palettize (PaletteCreationMethod -> Bool -> Int -> PaletteOptions
PaletteOptions PaletteCreationMethod
MedianMeanCut Bool
True Int
256) Image PixelRGB8
img
(Image Int
w Int
h Vector (PixelBaseComponent ColorNumber)
vec) = Image ColorNumber
img'
(Image Int
_ Int
_ Vector (PixelBaseComponent PixelRGB8)
p) = Image PixelRGB8
palette
bsize <- CInt -> CInt -> IO CInt
c_bufsize (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
let (sptr, _) = V.unsafeToForeignPtr0 vec
(spalette, _) = V.unsafeToForeignPtr0 p
B.createAndTrim (fromIntegral bsize) $ \Ptr ColorNumber
dst -> do
ForeignPtr ColorNumber -> (Ptr ColorNumber -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ColorNumber
spalette ((Ptr ColorNumber -> IO Int) -> IO Int)
-> (Ptr ColorNumber -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr ColorNumber
colors -> do
ForeignPtr ColorNumber -> (Ptr ColorNumber -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ColorNumber
sptr ((Ptr ColorNumber -> IO Int) -> IO Int)
-> (Ptr ColorNumber -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr ColorNumber
src -> do
len <- Ptr () -> Ptr () -> Ptr () -> CInt -> CInt -> IO CInt
c_img2palettized_sixel (Ptr ColorNumber -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ColorNumber
dst) (Ptr ColorNumber -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ColorNumber
src) (Ptr ColorNumber -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ColorNumber
colors) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
return (fromIntegral len)
putImage :: FilePath -> IO ()
putImage :: String -> IO ()
putImage String
file = do
String -> IO (Either String DynamicImage)
readImage String
file IO (Either String DynamicImage)
-> (Either String DynamicImage -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left String
err -> String -> IO ()
forall a. Show a => a -> IO ()
print String
err
Right DynamicImage
img -> DynamicImage -> IO ()
forall a. ToSixel a => a -> IO ()
putSixel DynamicImage
img