{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.OSC1337
  ( module Data.OSC1337,
    LatexStr (..),
    latex,
    math,
  )
where

import Codec.Picture
import Codec.Picture.Png (encodePng)
import qualified Data.ByteString as B
import Data.ByteString (ByteString)
import Data.ByteString.Base64 (encode)
import qualified Data.ByteString.Char8 as BC
import Data.ByteString.Lazy (toStrict)
import Data.Sixel.Internal
import System.IO.Unsafe (unsafePerformIO)

data OSCCmd
  = Start
  | End
  | FileName String
  | Size Int
  | Width Int
  | Height Int
  | PreserveAspectRatio Int
  | Inline Int
  | Align String
  | MimeType String
  | ImageDat String
  deriving (OSCCmd -> OSCCmd -> Bool
(OSCCmd -> OSCCmd -> Bool)
-> (OSCCmd -> OSCCmd -> Bool) -> Eq OSCCmd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OSCCmd -> OSCCmd -> Bool
== :: OSCCmd -> OSCCmd -> Bool
$c/= :: OSCCmd -> OSCCmd -> Bool
/= :: OSCCmd -> OSCCmd -> Bool
Eq)

instance Show OSCCmd where
  show :: OSCCmd -> String
show = \case
    OSCCmd
Start -> String
"\ESC]1337;"
    OSCCmd
End -> String
"\a"
    Size Int
s -> String
"size=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
    Width Int
s -> String
"width=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
    Height Int
s -> String
"height=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
    PreserveAspectRatio Int
s -> String
"preserveAspectRatio=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
    Inline Int
s -> String
"inline=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
    Align String
s -> String
"align=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
    MimeType String
s -> String
"type=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";"
    ImageDat String
s -> ByteString -> String
BC.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BC.pack String
s

instance {-# OVERLAPS #-} Show [OSCCmd] where
  show :: [OSCCmd] -> String
show [OSCCmd]
xs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (OSCCmd -> String) -> [OSCCmd] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map OSCCmd -> String
forall a. Show a => a -> String
show [OSCCmd]
xs

newtype OSCImage = OSCImage {OSCImage -> String
toOSCString :: String} deriving (OSCImage -> OSCImage -> Bool
(OSCImage -> OSCImage -> Bool)
-> (OSCImage -> OSCImage -> Bool) -> Eq OSCImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OSCImage -> OSCImage -> Bool
== :: OSCImage -> OSCImage -> Bool
$c/= :: OSCImage -> OSCImage -> Bool
/= :: OSCImage -> OSCImage -> Bool
Eq)

instance Show OSCImage where
  show :: OSCImage -> String
show (OSCImage String
img) = String
img

-- | See https://chromium.googlesource.com/apps/libapps/+/master/hterm/doc/ControlSequences.md#OSC-1337
class ToOSC a where
  toOSC :: a -> OSCImage
  putOSC :: a -> IO ()

instance {-# OVERLAPS #-} (Show a) => ToOSC a where
  toOSC :: a -> OSCImage
toOSC a
xs = String -> OSCImage
OSCImage (String -> OSCImage) -> String -> OSCImage
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
xs
  putOSC :: a -> IO ()
putOSC 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

img2osc :: Image PixelRGB8 -> ByteString
img2osc :: Image PixelRGB8 -> ByteString
img2osc Image PixelRGB8
img =
  let (Image Int
w Int
h Vector (PixelBaseComponent PixelRGB8)
_) = Image PixelRGB8
img
      dat :: ByteString
dat = LazyByteString -> ByteString
toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> LazyByteString
forall a. PngSavable a => Image a -> LazyByteString
encodePng Image PixelRGB8
img
   in [ByteString] -> ByteString
B.concat
        [ ByteString
"\ESC]1337;File=name=",
          ByteString -> ByteString
encode ByteString
"display.png",
          ByteString
";",
          ByteString
"width=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BC.pack (Int -> String
forall a. Show a => a -> String
show Int
w) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"px;",
          ByteString
"height=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BC.pack (Int -> String
forall a. Show a => a -> String
show Int
h) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"px;",
          ByteString
"inline=1;:",
          ByteString -> ByteString
encode ByteString
dat,
          ByteString
"\a"
        ]

instance {-# OVERLAPS #-} ToOSC DynamicImage where
  toOSC :: DynamicImage -> OSCImage
toOSC DynamicImage
dimg = Image PixelRGB8 -> OSCImage
forall a. ToOSC a => a -> OSCImage
toOSC (Image PixelRGB8 -> OSCImage) -> Image PixelRGB8 -> OSCImage
forall a b. (a -> b) -> a -> b
$ DynamicImage -> Image PixelRGB8
convertRGB8 DynamicImage
dimg
  putOSC :: DynamicImage -> IO ()
putOSC DynamicImage
img = Image PixelRGB8 -> IO ()
forall a. ToOSC a => a -> IO ()
putOSC (Image PixelRGB8 -> IO ()) -> Image PixelRGB8 -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicImage -> Image PixelRGB8
convertRGB8 DynamicImage
img

instance {-# OVERLAPS #-} ToOSC (Image PixelRGB8) where
  toOSC :: Image PixelRGB8 -> OSCImage
toOSC Image PixelRGB8
img = String -> OSCImage
OSCImage (ByteString -> String
BC.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> ByteString
img2osc Image PixelRGB8
img)
  putOSC :: Image PixelRGB8 -> IO ()
putOSC Image PixelRGB8
img = ByteString -> IO ()
B.putStr (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> ByteString
img2osc Image PixelRGB8
img

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. ToOSC a => a -> IO ()
putOSC DynamicImage
img

instance Show LatexStr where
  show :: LatexStr -> String
show LatexStr
str = OSCImage -> String
forall a. Show a => a -> String
show (OSCImage -> String) -> OSCImage -> String
forall a b. (a -> b) -> a -> b
$ LatexStr -> OSCImage
forall a. ToOSC a => a -> OSCImage
toOSC LatexStr
str

instance ToOSC LatexStr where
  toOSC :: LatexStr -> OSCImage
toOSC LatexStr
str = IO OSCImage -> OSCImage
forall a. IO a -> a
unsafePerformIO (IO OSCImage -> OSCImage) -> IO OSCImage -> OSCImage
forall a b. (a -> b) -> a -> b
$ do
    LatexStr -> IO (Either String DynamicImage)
latex2img LatexStr
str IO (Either String DynamicImage)
-> (Either String DynamicImage -> IO OSCImage) -> IO OSCImage
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 OSCImage
forall a. HasCallStack => String -> a
error String
err
      Right DynamicImage
img -> OSCImage -> IO OSCImage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (OSCImage -> IO OSCImage) -> OSCImage -> IO OSCImage
forall a b. (a -> b) -> a -> b
$ DynamicImage -> OSCImage
forall a. ToOSC a => a -> OSCImage
toOSC DynamicImage
img
  putOSC :: LatexStr -> IO ()
putOSC LatexStr
img = String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ OSCImage -> String
forall a. Show a => a -> String
show (OSCImage -> String) -> OSCImage -> String
forall a b. (a -> b) -> a -> b
$ LatexStr -> OSCImage
forall a. ToOSC a => a -> OSCImage
toOSC LatexStr
img