diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,19 @@ # Changelog +## 0.14.2.0 (2024-03-10) + + * Fix WezTerm image rendering when using panes (#182). + * Bump `ansi-terminal` upper bound to 1.2 and lower bound to 1.1. + This adds the ability to set colors on underlines. + * Bump `pandoc` upper bound to 3.7. + * Bump `tasty-quickcheck` upper bound to 0.12. + +## 0.14.1.0 (2024-02-22) + + * Add image support for WezTerm (#177). + * Fix image support in Kitty (#179). + * Fix image scroll issue for iTerm2. + ## 0.14.0.0 (2024-02-06) * Align based on final layout for incremental lists and other fragments diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ 🥔 patat ======== -![CI](https://github.com/jaspervdj/patat/workflows/CI/badge.svg) [![Hackage](https://img.shields.io/hackage/v/patat.svg)](https://hackage.haskell.org/package/patat) [![GitHub tag](https://img.shields.io/github/tag/jaspervdj/patat.svg)]() +![CI](https://github.com/jaspervdj/patat/actions/workflows/haskell-ci.yml/badge.svg) [![Hackage](https://img.shields.io/hackage/v/patat.svg)](https://hackage.haskell.org/package/patat) [![GitHub tag](https://img.shields.io/github/tag/jaspervdj/patat.svg)]() `patat` (**P**resentations **A**top **T**he **A**NSI **T**erminal) is a feature-rich presentation tool that runs in the terminal. @@ -517,6 +517,15 @@ needs to support 24-bit RGB for this to work. When creating portable presentations, it might be better to stick with the named colours listed above. +To customize the color of the `underline`, combine the prefix with a color, for +example: + +```yaml +patat: + theme: + strong: [underline, underlineVividBlue] +``` + ### Syntax Highlighting `patat` uses [Kate] Syntax Highlighting files. `patat` ships with support for @@ -625,9 +634,13 @@ - `backend: iterm2`: uses [iTerm2](https://iterm2.com/)'s special escape sequence to render the image. This even works with animated GIFs! + Note that it can have issues running under `tmux`. - `backend: kitty`: uses [Kitty's icat command](https://sw.kovidgoyal.net/kitty/kittens/icat.html). + +- `backend: wezterm`: uses the iTerm2 image protocol as implemented by + WezTerm. - `backend: w3m`: uses the `w3mimgdisplay` executable to draw directly onto the window. This has been tested in `urxvt` and `xterm`, but is known to diff --git a/lib/Patat/Images.hs b/lib/Patat/Images.hs --- a/lib/Patat/Images.hs +++ b/lib/Patat/Images.hs @@ -17,6 +17,7 @@ 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 @@ -- 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) ] diff --git a/lib/Patat/Images/ITerm2.hs b/lib/Patat/Images/ITerm2.hs --- a/lib/Patat/Images/ITerm2.hs +++ b/lib/Patat/Images/ITerm2.hs @@ -11,7 +11,6 @@ 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 @@ 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" diff --git a/lib/Patat/Images/Internal.hs b/lib/Patat/Images/Internal.hs --- a/lib/Patat/Images/Internal.hs +++ b/lib/Patat/Images/Internal.hs @@ -6,16 +6,19 @@ , 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 qualified Data.List as L +import Data.Typeable (Typeable) import Patat.Cleanup - +import System.Environment +import qualified System.IO as IO -------------------------------------------------------------------------------- data Config a = Auto | Explicit a deriving (Eq) @@ -38,3 +41,15 @@ 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 + putStr $ if inScreen then "\a\ESC\\" else "\a" + -- Make sure we don't print a newline after the image, or it may scroll + -- slightly out of view to the top. We flush instead. + IO.hFlush IO.stdout diff --git a/lib/Patat/Images/Kitty.hs b/lib/Patat/Images/Kitty.hs --- a/lib/Patat/Images/Kitty.hs +++ b/lib/Patat/Images/Kitty.hs @@ -6,15 +6,16 @@ -------------------------------------------------------------------------------- -import Control.Exception (throwIO) -import Control.Monad (unless, void, when) -import qualified Data.Aeson as A -import qualified Data.List as L -import Patat.Cleanup (Cleanup) -import qualified Patat.Images.Internal as Internal -import Data.Functor (($>)) -import System.Environment (lookupEnv) -import System.Process (readProcess) +import Control.Exception (throwIO) +import Control.Monad (unless, void, when) +import qualified Data.Aeson as A +import Data.Functor (($>)) +import qualified Data.List as L +import Patat.Cleanup (Cleanup) +import qualified Patat.Images.Internal as Internal +import System.Environment (lookupEnv) +import qualified System.IO as IO +import qualified System.Process as Process -------------------------------------------------------------------------------- @@ -42,5 +43,10 @@ drawImage :: FilePath -> IO Cleanup drawImage path = icat ["--align=center", path] $> icat ["--clear"] where - icat args = void $ readProcess - "kitty" ("+kitten" : "icat" : "--transfer-mode=stream" : args) "" + icat args = do + (Just inh, _, _, ph) <- Process.createProcess (Process.proc "kitty" + ("+kitten" : "icat" : "--transfer-mode=stream" : "--stdin=no" : args)) + { Process.std_in = Process.CreatePipe + } + IO.hClose inh + void $ Process.waitForProcess ph diff --git a/lib/Patat/Images/WezTerm.hs b/lib/Patat/Images/WezTerm.hs new file mode 100644 --- /dev/null +++ b/lib/Patat/Images/WezTerm.hs @@ -0,0 +1,136 @@ +-------------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Patat.Images.WezTerm + ( backend + ) where + + +-------------------------------------------------------------------------------- +import Codec.Picture (DynamicImage, + Image (imageHeight, imageWidth), + decodeImage, dynamicMap) +import Control.Exception (throwIO) +import Control.Monad (unless, when) +import qualified Data.Aeson as A +import qualified Data.ByteString as B +import qualified Data.ByteString.Base64 as B64 +import qualified Data.Text.Lazy as TL +import Data.Text.Lazy.Encoding (encodeUtf8) +import Patat.Cleanup (Cleanup) +import qualified Patat.Images.Internal as Internal +import System.Directory (findExecutable) +import System.Environment (lookupEnv) +import System.Process (readProcess) + + +-------------------------------------------------------------------------------- +backend :: Internal.Backend +backend = Internal.Backend new + + +-------------------------------------------------------------------------------- +data Config = Config deriving (Eq) +instance A.FromJSON Config where parseJSON _ = return Config + + +-------------------------------------------------------------------------------- +data Pane = + Pane { paneSize :: Size + , paneIsActive :: Bool + } deriving (Show) + +instance A.FromJSON Pane where + parseJSON = A.withObject "Pane" $ \o -> Pane + <$> o A..: "size" + <*> o A..: "is_active" + + +-------------------------------------------------------------------------------- +data Size = + Size { sizePixelWidth :: Int + , sizePixelHeight :: Int + } deriving (Show) + +instance A.FromJSON Size where + parseJSON = A.withObject "Size" $ \o -> Size + <$> o A..: "pixel_width" + <*> o A..: "pixel_height" + + +-------------------------------------------------------------------------------- +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 + + wez <- wezExecutable + resp <- fmap (encodeUtf8 . TL.pack) $ readProcess wez ["cli", "list", "--format", "json"] [] + let panes = (A.decode resp :: Maybe [Pane]) + + Internal.withEscapeSequence $ do + putStr "1337;File=inline=1;doNotMoveCursor=1;" + case decodeImage content of + Left _ -> pure () + Right img -> putStr $ wezArString (imageAspectRatio img) (activePaneAspectRatio panes) + putStr ":" + B.putStr (B64.encode content) + return mempty + + +-------------------------------------------------------------------------------- +wezArString :: Double -> Double -> String +wezArString i p | i < p = "width=auto;height=95%;" + | otherwise = "width=100%;height=auto;" + + +-------------------------------------------------------------------------------- +wezExecutable :: IO String +wezExecutable = do + w <- findExecutable "wezterm.exe" + case w of + Nothing -> return "wezterm" + Just x -> return x + + +-------------------------------------------------------------------------------- +imageAspectRatio :: DynamicImage -> Double +imageAspectRatio i = imgW i / imgH i + where + imgH = fromIntegral . (dynamicMap imageHeight) + imgW = fromIntegral . (dynamicMap imageWidth) + + +-------------------------------------------------------------------------------- +paneAspectRatio :: Pane -> Double +paneAspectRatio p = paneW p / paneH p + where + paneH = fromIntegral . sizePixelHeight . paneSize + paneW = fromIntegral . sizePixelWidth . paneSize + + +-------------------------------------------------------------------------------- +activePaneAspectRatio :: Maybe [Pane] -> Double +activePaneAspectRatio Nothing = defaultAr -- This should never happen +activePaneAspectRatio (Just x) = + case filter paneIsActive x of + [p] -> paneAspectRatio p + _ -> defaultAr -- This shouldn't either + + +-------------------------------------------------------------------------------- +defaultAr :: Double +defaultAr = (4 / 3 :: Double) -- Good enough for a VT100 + + diff --git a/lib/Patat/Main.hs b/lib/Patat/Main.hs --- a/lib/Patat/Main.hs +++ b/lib/Patat/Main.hs @@ -36,6 +36,7 @@ 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 @@ 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 diff --git a/lib/Patat/Theme.hs b/lib/Patat/Theme.hs --- a/lib/Patat/Theme.hs +++ b/lib/Patat/Theme.hs @@ -180,41 +180,41 @@ -------------------------------------------------------------------------------- sgrToString :: Ansi.SGR -> Maybe String -sgrToString (Ansi.SetColor layer intensity color) = Just $ - (\str -> case layer of - Ansi.Foreground -> str - Ansi.Background -> "on" ++ capitalize str) $ - (case intensity of - Ansi.Dull -> "dull" - Ansi.Vivid -> "vivid") ++ - (case color of - Ansi.Black -> "Black" - Ansi.Red -> "Red" - Ansi.Green -> "Green" - Ansi.Yellow -> "Yellow" - Ansi.Blue -> "Blue" - Ansi.Magenta -> "Magenta" - Ansi.Cyan -> "Cyan" - Ansi.White -> "White") +sgrToString sgr = case sgr of + Ansi.SetColor layer intensity color -> Just $ layerPrefix layer $ + (case intensity of + Ansi.Dull -> "dull" + Ansi.Vivid -> "vivid") ++ + (case color of + Ansi.Black -> "Black" + Ansi.Red -> "Red" + Ansi.Green -> "Green" + Ansi.Yellow -> "Yellow" + Ansi.Blue -> "Blue" + Ansi.Magenta -> "Magenta" + Ansi.Cyan -> "Cyan" + Ansi.White -> "White") -sgrToString (Ansi.SetUnderlining Ansi.SingleUnderline) = Just "underline" + Ansi.SetUnderlining Ansi.SingleUnderline -> Just "underline" -sgrToString (Ansi.SetConsoleIntensity Ansi.BoldIntensity) = Just "bold" + Ansi.SetConsoleIntensity Ansi.BoldIntensity -> Just "bold" -sgrToString (Ansi.SetItalicized True) = Just "italic" + Ansi.SetItalicized True -> Just "italic" -sgrToString (Ansi.SetRGBColor layer color) = Just $ - (\str -> case layer of - Ansi.Foreground -> str - Ansi.Background -> "on" ++ capitalize str) $ - "rgb#" ++ (toRGBHex $ toSRGB24 color) + Ansi.SetRGBColor layer color -> Just $ layerPrefix layer $ + "rgb#" ++ (toRGBHex $ toSRGB24 color) + + _ -> Nothing where toRGBHex (RGB r g b) = concat $ map toHexByte [r, g, b] toHexByte x = showHex2 x "" showHex2 x | x <= 0xf = ("0" ++) . showHex x | otherwise = showHex x -sgrToString _ = Nothing + layerPrefix layer str = case layer of + Ansi.Foreground -> str + Ansi.Background -> "on" ++ capitalize str + Ansi.Underlining -> "underline" ++ capitalize str -------------------------------------------------------------------------------- diff --git a/patat.cabal b/patat.cabal --- a/patat.cabal +++ b/patat.cabal @@ -1,5 +1,5 @@ Name: patat -Version: 0.14.0.0 +Version: 0.14.2.0 Synopsis: Terminal-based presentations using Pandoc Description: Terminal-based presentations using Pandoc. License: GPL-2 @@ -11,7 +11,7 @@ Category: Text Build-type: Simple Cabal-version: >=1.10 -Tested-with: GHC ==9.2.8 || ==9.4.8 || ==9.6.3 || ==9.8.1 +Tested-with: GHC ==9.2.8 || ==9.4.8 || ==9.6.3 || ==9.8.1 || ==9.8.4 Extra-source-files: CHANGELOG.md @@ -32,32 +32,33 @@ 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 >= 1.1 && < 1.2, + 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.7, + 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 @@ Patat.Images.ITerm2 Patat.Images.Kitty Patat.Images.W3m + Patat.Images.WezTerm Patat.Main Patat.Presentation Patat.Presentation.Display @@ -135,7 +137,7 @@ containers >= 0.6 && < 0.8, doctemplates >= 0.8 && < 0.12, mtl >= 2.2 && < 2.4, - pandoc >= 3.1 && < 3.6, + pandoc >= 3.1 && < 3.7, text >= 1.2 && < 2.2, time >= 1.6 && < 1.13 @@ -153,13 +155,13 @@ Build-depends: patat, - ansi-terminal >= 0.6 && < 1.1, + ansi-terminal >= 1.1 && < 1.2, base >= 4.8 && < 5, directory >= 1.2 && < 1.4, - pandoc >= 3.1 && < 3.6, + pandoc >= 3.1 && < 3.7, tasty >= 1.2 && < 1.6, tasty-hunit >= 0.10 && < 0.11, - tasty-quickcheck >= 0.10 && < 0.11, + tasty-quickcheck >= 0.10 && < 0.12, text >= 1.2 && < 2.2, QuickCheck >= 2.8 && < 2.15