Added image support for WezTerm (#177)

lib/Patat/Images.hs

@@ -17,6 +17,7 @@ import           Patat.Images.Internal
 import qualified Patat.Images.ITerm2         as ITerm2
 import qualified Patat.Images.Kitty          as Kitty
 import qualified Patat.Images.W3m            as W3m
+import qualified Patat.Images.WezTerm        as WezTerm
 import           Patat.Presentation.Internal
 
 
@@ -52,9 +53,10 @@ auto = go [] backends
 -- depending on platform availability.
 backends :: [(T.Text, Backend)]
 backends =
-    [ ("iterm2", ITerm2.backend)
-    , ("kitty",  Kitty.backend)
-    , ("w3m",    W3m.backend)
+    [ ("iterm2",  ITerm2.backend)
+    , ("kitty",   Kitty.backend)
+    , ("w3m",     W3m.backend)
+    , ("wezterm", WezTerm.backend)
     ]
 
 

lib/Patat/Images/ITerm2.hs

@@ -11,7 +11,6 @@ import           Control.Monad               (unless, when)
 import qualified Data.Aeson                  as A
 import qualified Data.ByteString.Base64.Lazy as B64
 import qualified Data.ByteString.Lazy        as BL
-import qualified Data.List                   as L
 import           Patat.Cleanup               (Cleanup)
 import qualified Patat.Images.Internal       as Internal
 import           System.Environment          (lookupEnv)
@@ -42,17 +41,7 @@ new config = do
 drawImage :: FilePath -> IO Cleanup
 drawImage path = do
     content <- BL.readFile path
-    withEscapeSequence $ do
+    Internal.withEscapeSequence $ do
         putStr "1337;File=inline=1;width=100%;height=100%:"
         BL.putStr (B64.encode content)
     return mempty
-
-
---------------------------------------------------------------------------------
-withEscapeSequence :: IO () -> IO ()
-withEscapeSequence f = do
-    term <- lookupEnv "TERM"
-    let inScreen = maybe False ("screen" `L.isPrefixOf`) term
-    putStr $ if inScreen then "\ESCPtmux;\ESC\ESC]" else "\ESC]"
-    f
-    putStrLn $ if inScreen then "\a\ESC\\" else "\a"

lib/Patat/Images/Internal.hs

@@ -6,16 +6,18 @@ module Patat.Images.Internal
     , Backend (..)
     , BackendNotSupported (..)
     , Handle (..)
+    , withEscapeSequence
     ) where
 
 
 --------------------------------------------------------------------------------
-import           Control.Exception (Exception)
-import qualified Data.Aeson        as A
-import           Data.Data         (Data)
-import           Data.Typeable     (Typeable)
+import           Control.Exception    (Exception)
+import qualified Data.Aeson           as A
+import           Data.Data            (Data)
+import           Data.Typeable        (Typeable)
 import           Patat.Cleanup
-
+import           System.Environment
+import qualified Data.List            as L
 
 --------------------------------------------------------------------------------
 data Config a = Auto | Explicit a deriving (Eq)
@@ -38,3 +40,12 @@ instance Exception BackendNotSupported
 data Handle = Handle
     { hDrawImage  :: FilePath -> IO Cleanup
     }
+
+--------------------------------------------------------------------------------
+withEscapeSequence :: IO () -> IO ()
+withEscapeSequence f = do
+    term <- lookupEnv "TERM"
+    let inScreen = maybe False ("screen" `L.isPrefixOf`) term
+    putStr $ if inScreen then "\ESCPtmux;\ESC\ESC]" else "\ESC]"
+    f
+    putStrLn $ if inScreen then "\a\ESC\\" else "\a"

lib/Patat/Images/WezTerm.hs

@@ -0,0 +1,61 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE TemplateHaskell #-}
+module Patat.Images.WezTerm
+    ( backend
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Control.Exception           (throwIO)
+import           Control.Monad               (unless, when)
+import           Codec.Picture
+import qualified Data.Aeson                  as A
+import qualified Data.ByteString.Base64      as B64
+import qualified Data.ByteString             as B
+import           Patat.Cleanup               (Cleanup)
+import qualified Patat.Images.Internal       as Internal
+import           System.Environment          (lookupEnv)
+
+
+--------------------------------------------------------------------------------
+backend :: Internal.Backend
+backend = Internal.Backend new
+
+
+--------------------------------------------------------------------------------
+data Config = Config deriving (Eq)
+instance A.FromJSON Config where parseJSON _ = return Config
+
+
+--------------------------------------------------------------------------------
+new :: Internal.Config Config -> IO Internal.Handle
+new config = do
+    when (config == Internal.Auto) $ do
+        termProgram <- lookupEnv "TERM_PROGRAM"
+        unless (termProgram == Just "WezTerm") $ throwIO $
+            Internal.BackendNotSupported "TERM_PROGRAM not WezTerm"
+
+    return Internal.Handle {Internal.hDrawImage = drawImage}
+
+
+--------------------------------------------------------------------------------
+drawImage :: FilePath -> IO Cleanup
+drawImage path = do
+    content <- B.readFile path
+    Internal.withEscapeSequence $ do
+        putStr "1337;File=inline=1;doNotMoveCursor=1;"
+        case decodeImage content of
+            Left _ -> pure () 
+            Right img -> putStr $ getAspectRatio img
+        putStr ":"
+        B.putStr (B64.encode content)
+    return mempty
+
+
+--------------------------------------------------------------------------------
+getAspectRatio  :: DynamicImage -> String
+getAspectRatio i | go_w i / go_h i < (1 :: Double) = "width=auto;height=95%;"
+                 | otherwise                       = "width=100%;height=auto;"
+    where
+          go_h = fromIntegral . (dynamicMap imageHeight)
+          go_w = fromIntegral . (dynamicMap imageWidth)

lib/Patat/Main.hs

@@ -36,6 +36,7 @@ import           Prelude
 import qualified System.Console.ANSI              as Ansi
 import           System.Directory                 (doesFileExist,
                                                    getModificationTime)
+import           System.Environment               (lookupEnv)
 import           System.Exit                      (exitFailure, exitSuccess)
 import qualified System.IO                        as IO
 import qualified Text.Pandoc                      as Pandoc
@@ -306,7 +307,11 @@ interactively reader app = bracket setup teardown $ \(_, _, chan) ->
         buff <- IO.hGetBuffering IO.stdin
         IO.hSetEcho      IO.stdin False
         IO.hSetBuffering IO.stdin IO.NoBuffering
-        Ansi.hideCursor
+
+        -- Suppress cursor hiding for WezTerm image compatibility
+        termProgram <- lookupEnv "TERM_PROGRAM"
+        unless (termProgram == Just "WezTerm") $ Ansi.hideCursor
+
         return (echo, buff, chan)
 
     teardown (echo, buff, _chan) = do

patat.cabal

@@ -32,32 +32,33 @@ Library
   Default-language:  Haskell2010
 
   Build-depends:
-    aeson                >= 2.0  && < 2.3,
-    ansi-terminal        >= 0.6  && < 1.1,
-    ansi-wl-pprint       >= 0.6  && < 1.1,
-    async                >= 2.2  && < 2.3,
-    base                 >= 4.9  && < 5,
-    base64-bytestring    >= 1.0  && < 1.3,
-    bytestring           >= 0.10 && < 0.13,
-    colour               >= 2.3  && < 2.4,
-    containers           >= 0.5  && < 0.7,
-    directory            >= 1.2  && < 1.4,
-    filepath             >= 1.4  && < 1.6,
-    hashable             >= 1.4  && < 1.5,
-    mtl                  >= 2.2  && < 2.4,
-    optparse-applicative >= 0.16 && < 0.19,
-    pandoc               >= 3.1  && < 3.6,
-    pandoc-types         >= 1.23 && < 1.24,
-    process              >= 1.6  && < 1.7,
-    random               >= 1.2  && < 1.3,
-    skylighting          >= 0.10 && < 0.15,
-    terminal-size        >= 0.3  && < 0.4,
-    text                 >= 1.2  && < 2.2,
-    time                 >= 1.4  && < 1.13,
-    unordered-containers >= 0.2  && < 0.3,
-    yaml                 >= 0.8  && < 0.12,
-    vector               >= 0.13 && < 0.14,
-    wcwidth              >= 0.0  && < 0.1,
+    aeson                >= 2.0   && < 2.3,
+    ansi-terminal        >= 0.6   && < 1.1,
+    ansi-wl-pprint       >= 0.6   && < 1.1,
+    async                >= 2.2   && < 2.3,
+    base                 >= 4.9   && < 5,
+    base64-bytestring    >= 1.0   && < 1.3,
+    bytestring           >= 0.10  && < 0.13,
+    colour               >= 2.3   && < 2.4,
+    containers           >= 0.5   && < 0.7,
+    directory            >= 1.2   && < 1.4,
+    filepath             >= 1.4   && < 1.6,
+    hashable             >= 1.4   && < 1.5,
+    JuicyPixels          >= 3.3.3 && < 3.4,
+    mtl                  >= 2.2   && < 2.4,
+    optparse-applicative >= 0.16  && < 0.19,
+    pandoc               >= 3.1   && < 3.6,
+    pandoc-types         >= 1.23  && < 1.24,
+    process              >= 1.6   && < 1.7,
+    random               >= 1.2   && < 1.3,
+    skylighting          >= 0.10  && < 0.15,
+    terminal-size        >= 0.3   && < 0.4,
+    text                 >= 1.2   && < 2.2,
+    time                 >= 1.4   && < 1.13,
+    unordered-containers >= 0.2   && < 0.3,
+    yaml                 >= 0.8   && < 0.12,
+    vector               >= 0.13  && < 0.14,
+    wcwidth              >= 0.0   && < 0.1,
     -- We don't even depend on these packages but they can break cabal install
     -- because of the conflicting 'Network.URI' module.
     network-uri >= 2.6,
@@ -78,6 +79,7 @@ Library
     Patat.Images.ITerm2
     Patat.Images.Kitty
     Patat.Images.W3m
+    Patat.Images.WezTerm
     Patat.Main
     Patat.Presentation
     Patat.Presentation.Display