Wezterm image rendering fixes

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
+
+

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,