diff --git a/lib/Patat/Images/WezTerm.hs b/lib/Patat/Images/WezTerm.hs index 2812e04..0e924da 100644 --- a/lib/Patat/Images/WezTerm.hs +++ b/lib/Patat/Images/WezTerm.hs @@ -1,20 +1,27 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# 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) +import Control.Exception (throwIO) +import Control.Monad (unless, when) +import qualified Data.Aeson as A +import Data.Aeson.Casing as AC +import qualified Data.ByteString as B +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Lazy.UTF8 as BLU +import GHC.Generics (Generic) +import Patat.Cleanup (Cleanup) +import qualified Patat.Images.Internal as Internal +import System.Environment (lookupEnv) +import System.Process -------------------------------------------------------------------------------- @@ -27,6 +34,26 @@ data Config = Config deriving (Eq) instance A.FromJSON Config where parseJSON _ = return Config +-------------------------------------------------------------------------------- +data Pane = + Pane { paneSize :: Size + , paneIsActive :: Bool + } deriving (Show, Generic) + +instance A.FromJSON Pane where + parseJSON = A.genericParseJSON $ AC.aesonPrefix AC.snakeCase + + +-------------------------------------------------------------------------------- +data Size = + Size { sizePixelWidth :: Int + , sizePixelHeight :: Int + } deriving (Show, Generic) + +instance A.FromJSON Size where + parseJSON = A.genericParseJSON $ AC.aesonPrefix AC.snakeCase + + -------------------------------------------------------------------------------- new :: Internal.Config Config -> IO Internal.Handle new config = do @@ -42,20 +69,52 @@ new config = do drawImage :: FilePath -> IO Cleanup drawImage path = do content <- B.readFile path + resp <- fmap BLU.fromString $ readProcess "wezterm.exe" ["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 $ getAspectRatio img + Left _ -> pure () + Right img -> putStr $ wezArString (imageAspectRatio img) (activePaneAspectRatio panes) 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;" +wezArString :: Double -> Double -> String +wezArString i p | i < p = "width=auto;height=95%;" + | otherwise = "width=100%;height=auto;" + + +-------------------------------------------------------------------------------- +imageAspectRatio :: DynamicImage -> Double +imageAspectRatio i = imgW i / imgH i where - go_h = fromIntegral . (dynamicMap imageHeight) - go_w = fromIntegral . (dynamicMap imageWidth) + 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/patat.cabal b/patat.cabal index e010a96..b82711c 100644 --- a/patat.cabal +++ b/patat.cabal @@ -33,6 +33,7 @@ Library Build-depends: aeson >= 2.0 && < 2.3, + aeson-casing >= 0.1 && < 0.3, ansi-terminal >= 0.6 && < 1.1, ansi-wl-pprint >= 0.6 && < 1.1, async >= 2.2 && < 2.3, @@ -56,6 +57,7 @@ Library text >= 1.2 && < 2.2, time >= 1.4 && < 1.13, unordered-containers >= 0.2 && < 0.3, + utf8-string >= 0.3.1 && < 2.0, yaml >= 0.8 && < 0.12, vector >= 0.13 && < 0.14, wcwidth >= 0.0 && < 0.1,