patat 0.9.2.0 → 0.10.0.0

raw patch · 22 files changed

+1538/−816 lines, 22 filesdep +randomdep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: random, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +42/−0
• README.md +109/−20
• lib/Control/Concurrent/Chan/Extended.hs +15/−0
• lib/Patat/AutoAdvance.hs +36/−21
• lib/Patat/Images.hs +6/−6
• lib/Patat/Main.hs +169/−94
• lib/Patat/Presentation.hs +1/−1
• lib/Patat/Presentation/Comments.hs +174/−0
• lib/Patat/Presentation/Display.hs +38/−50
• lib/Patat/Presentation/Interactive.hs +0/−1
• lib/Patat/Presentation/Internal.hs +57/−204
• lib/Patat/Presentation/Read.hs +40/−29
• lib/Patat/Presentation/Settings.hs +236/−0
• lib/Patat/Presentation/SpeakerNotes.hs +0/−110
• lib/Patat/PrettyPrint.hs +4/−278
• lib/Patat/PrettyPrint/Internal.hs +319/−0
• lib/Patat/PrettyPrint/Matrix.hs +75/−0
• lib/Patat/Size.hs +23/−0
• lib/Patat/Transition.hs +42/−0
• lib/Patat/Transition/Internal.hs +81/−0
• lib/Patat/Transition/SlideLeft.hs +59/−0
• patat.cabal +12/−2

@@ -1,5 +1,47 @@ # Changelog +## 0.10.0.0 (2023-10-12)++ *  Add transition effects (#149)++    This adds a framework for setting transition effects in between slides. Only+    a single transition type is implemented at this point, `slideLeft`.++    Example configuration:++        patat:+          transition:+            type: slideLeft+            frames: 24  # Optional+            duration: 1  # Seconds, optional+++ *  Allow overriding certain settings in slides (#148)++    Configuration was typically done in the metadata block of the input file,+    or in a per-user configuration.  These settings are applied to the entire+    presentation.++    We now allow selectively overriding these settings on a per-slide basis,+    by adding one or more config blocks to those slides.  Config blocks are+    comments that start with `config:`.  They can be placed anywhere in the+    slide.++        # This is a normal slide++        Normal slide content++        # This slide has a different colour header++        <!--config:+        theme:+          header: [vividYellow]+        -->++        Wow, how did that happen?++ *  Allow configuring top margin (#147)+ ## 0.9.2.0 (2023-09-26)   *  Read configuration from XDG standard directory (#146)

@@ -15,6 +15,7 @@ - Display [speaker notes](#speaker-notes) in a second window or monitor. - [Incremental slide display](#fragmented-slides). - Experimental [images](#images) support.+- [Transition effects](#transitions). - Supports [smart slide splitting](#input-format). - [Auto advancing](#auto-advancing) with configurable delay. - Optionally [re-wrapping](#line-wrapping) text to terminal width with proper@@ -42,6 +43,7 @@ -   [Input format](#input-format) -   [Configuration](#configuration)     -   [Line wrapping](#line-wrapping)+    -   [Margins](#margins)     -   [Auto advancing](#auto-advancing)     -   [Advanced slide splitting](#advanced-slide-splitting)     -   [Fragmented slides](#fragmented-slides)@@ -50,8 +52,10 @@     -   [Pandoc Extensions](#pandoc-extensions)     -   [Images](#images)     -   [Breadcrumbs](#breadcrumbs)+    -   [Slide numbers](#slide-numbers)     -   [Evaluating code](#evaluating-code)     -   [Speaker notes](#speaker-notes)+    -   [Transitions](#transitions) -   [Trivia](#trivia)  Installation@@ -249,32 +253,61 @@  1.  For per-user configuration you can use     `$XDG_CONFIG_DIRECTORY/patat/config.yaml`-    (typically `$HOME/.config/patat/config.yaml`) or `$HOME/.patat.yaml`.+    (typically `$HOME/.config/patat/config.yaml`) or `$HOME/.patat.yaml`, for+    example:++    ```yaml+    slideNumber: false+    ```+ 2.  In the presentation file itself, using the [Pandoc metadata header].     These settings take precedence over anything specified in the per-user-    configuration file.+    configuration file.  They must be placed in a `patat:` section, so they+    don't conflict with metadata: -[YAML]: http://yaml.org/-[Pandoc metadata header]: http://pandoc.org/MANUAL.html#extension-yaml_metadata_block+    ```markdown+    ---+    title: Presentation with options+    author: John Doe+    patat:+        slideNumber: false+    ... -For example, we set an option `key` to `val` by using the following file:+    Hello world.+    ``` -```markdown-----title: Presentation with options-author: John Doe-patat:-    key: val-...+3.  Within a slide, using a comment starting with `<!--config:`.  These+    settings can override configuration for that specific slide only.+    There should not be any whitespace between `<!--` and `config:`. -Hello world.-```+    ```markdown+    # First slide -Or we can use a "plain" presentation and have the following-`$XDG_CONFIG_DIRECTORY/patat/config.yaml`:+    Slide numbers are turned on here. -    key: val+    # Second slide +    <!--config:+    slideNumber: false+    -->++    Slide numbers are turned off here.+    ```++    The following settings can **not** be set in a slide configuration block,+    and doing so will result in an error:++     -  `autoAdvanceDelay`+     -  `eval`+     -  `images`+     -  `incrementalLists`+     -  `pandocExtensions`+     -  `slideLevel`+     -  `speakerNotes`++[YAML]: http://yaml.org/+[Pandoc metadata header]: http://pandoc.org/MANUAL.html#extension-yaml_metadata_block+ ### Line wrapping  Line wrapping can be enabled by setting `wrap: true` in the configuration.  This@@ -293,16 +326,23 @@     margins:         left: 10         right: 10+        top: 5 ...  Lorem ipsum dolor sit amet, ... ``` -This example configuration will generate slides with a margin of 10 characters on the left,-and break lines 10 characters before they reach the end of the terminal's width.+This example configuration will generate slides with a margin of 10 columns on+the left, and it will wrap long lines 10 columns before the right side of the+terminal.  Additionally, there will be 5 empty lines in between the title bar+and slide content. -It is recommended to enable [line wrapping](#line-wrapping) along with this feature.+[Line wrapping](#line-wrapping) should be enabled when using non-zero `right`+margin. +By default, the `left` and `right` margin are set to 0, and the `top` margin is+set to 1.+ ### Auto advancing  By setting `autoAdvanceDelay` to a number of seconds, `patat` will automatically@@ -724,6 +764,51 @@ patat -w /tmp/notes.txt ``` +Note that speaker notes should not start with `<!--config:`, since then they+will be parsed as [configuration](#configuration) blocks.  They are allowed+to start with `<!-- config:`; the lack of whitespace matters.++### Transitions++`patat` supports transitions in between slides.  A relatively fast terminal+emulator (e.g. [Alacritty], [Kitty], [iTerm2])+is suggested when enabling this, to avoid too much flickering -- some+flickering is unavoidable since we redraw the entire screen on each frame.++```yaml+patat:+  transition:+    type: slideLeft+```++To set transitions on specific slides, use `<!--config:` blocks, as detailed+in the [configuration section](#configuration).  For example:++```markdown+# Slide one++Slide one content.++# Slide two++<!--config:+transition:+  type: slideLeft+  duration: 2+-->++Slide two content.+```++Supported transitions `type`s:++ -  `slideLeft`: slides the new slide in from right to left.++    Arguments:++     -  `frameRate`: number of frames per second.  Defaults to 24.+     -  `duration`: duration of the animation in seconds.  Defaults to 1.+ Trivia ------ @@ -740,3 +825,7 @@ [MDP]: https://github.com/visit1985/mdp [VTMC]: https://github.com/jclulow/vtmc [Literate Haskell]: https://wiki.haskell.org/Literate_programming++[Alacritty]: https://alacritty.org/+[iTerm2]: https://iterm2.com/+[Kitty]: https://sw.kovidgoyal.net/kitty/

@@ -0,0 +1,15 @@+module Control.Concurrent.Chan.Extended+    ( module Control.Concurrent.Chan+    , withMapChan+    ) where++import qualified Control.Concurrent.Async as Async+import           Control.Concurrent.Chan+import           Control.Monad            (forever)++withMapChan :: (a -> b) -> Chan a -> (Chan b -> IO r) -> IO r+withMapChan f chan cont = do+    new <- newChan+    Async.withAsync+        (forever $ readChan chan >>= writeChan new . f)+        (\_ -> cont new)

@@ -1,11 +1,13 @@ -------------------------------------------------------------------------------- module Patat.AutoAdvance-    ( autoAdvance+    ( maybeAutoAdvance+    , autoAdvance     ) where   ---------------------------------------------------------------------------------import           Control.Concurrent      (forkIO, threadDelay)+import           Control.Concurrent      (threadDelay)+import qualified Control.Concurrent.Async as Async import qualified Control.Concurrent.Chan as Chan import           Control.Monad           (forever) import qualified Data.IORef              as IORef@@ -14,14 +16,26 @@   --------------------------------------------------------------------------------+-- | Utility to make auto advancing optional.+maybeAutoAdvance+    :: Maybe Int+    -> Chan.Chan PresentationCommand+    -> (Chan.Chan PresentationCommand -> IO a)+    -> IO a+maybeAutoAdvance Nothing             chan f = f chan+maybeAutoAdvance (Just delaySeconds) chan f = autoAdvance delaySeconds chan f+++-------------------------------------------------------------------------------- -- | This function takes an existing channel for presentation commands -- (presumably coming from human input) and creates a new one that /also/ sends -- a 'Forward' command if nothing happens for N seconds. autoAdvance     :: Int     -> Chan.Chan PresentationCommand-    -> IO (Chan.Chan PresentationCommand)-autoAdvance delaySeconds existingChan = do+    -> (Chan.Chan PresentationCommand -> IO a)+    -> IO a+autoAdvance delaySeconds existingChan f = do     let delay = delaySeconds * 1000  -- We are working with ms in this function      newChan         <- Chan.newChan@@ -29,24 +43,25 @@      -- This is a thread that copies 'existingChan' to 'newChan', and writes     -- whenever the latest command was to 'latestCommandAt'.-    _ <- forkIO $ forever $ do+    (forever $ do         cmd <- Chan.readChan existingChan         getCurrentTime >>= IORef.writeIORef latestCommandAt-        Chan.writeChan newChan cmd+        Chan.writeChan newChan cmd) `Async.withAsync` \_ -> -    -- This is a thread that waits around 'delay' seconds and then checks if-    -- there's been a more recent command.  If not, we write a 'Forward'.-    _ <- forkIO $ forever $ do-        current <- getCurrentTime-        latest  <- IORef.readIORef latestCommandAt-        let elapsed = floor $ 1000 * (current `diffUTCTime` latest) :: Int-        if elapsed >= delay-            then do-                Chan.writeChan newChan Forward-                IORef.writeIORef latestCommandAt current-                threadDelay (delay * 1000)-            else do-                let wait = delay - elapsed-                threadDelay (wait * 1000)+        -- This is a thread that waits around 'delay' seconds and then checks if+        -- there's been a more recent command.  If not, we write a 'Forward'.+        (forever $ do+            current <- getCurrentTime+            latest  <- IORef.readIORef latestCommandAt+            let elapsed = floor $ 1000 * (current `diffUTCTime` latest) :: Int+            if elapsed >= delay+                then do+                    Chan.writeChan newChan Forward+                    IORef.writeIORef latestCommandAt current+                    threadDelay (delay * 1000)+                else do+                    let wait = delay - elapsed+                    threadDelay (wait * 1000)) `Async.withAsync` \_ -> -    return newChan+        -- Continue main thread.+        f newChan

@@ -3,7 +3,7 @@ module Patat.Images     ( Backend     , Handle-    , new+    , withHandle     , drawImage     ) where @@ -21,16 +21,16 @@   ---------------------------------------------------------------------------------new :: ImageSettings -> IO Handle-new is-    | isBackend is == "auto" = auto+withHandle :: ImageSettings -> (Handle -> IO a) -> IO a+withHandle is f+    | isBackend is == "auto" = auto >>= f     | Just (Backend b) <- lookup (isBackend is) backends =         case A.fromJSON (A.Object $ isParams is) of-            A.Success c -> b (Explicit c)+            A.Success c -> b (Explicit c) >>= f             A.Error err -> fail $                 "Patat.Images.new: Error parsing config for " ++                 show (isBackend is) ++ " image backend: " ++ err-new is = fail $+withHandle is _ = fail $     "Patat.Images.new: Could not find " ++ show (isBackend is) ++     " image backend." 

@@ -8,33 +8,37 @@   ---------------------------------------------------------------------------------import           Control.Concurrent              (forkIO, killThread,-                                                  threadDelay)-import           Control.Concurrent.Chan         (Chan)-import qualified Control.Concurrent.Chan         as Chan-import           Control.Exception               (bracket)-import           Control.Monad                   (forever, unless, when)-import qualified Data.Aeson.Extended             as A-import           Data.Foldable                   (for_)-import           Data.Functor                    (($>))-import           Data.Time                       (UTCTime)-import           Data.Version                    (showVersion)-import qualified Options.Applicative             as OA-import qualified Options.Applicative.Help.Pretty as OA.PP+import           Control.Concurrent               (forkIO, threadDelay)+import qualified Control.Concurrent.Async         as Async+import           Control.Concurrent.Chan.Extended (Chan)+import qualified Control.Concurrent.Chan.Extended as Chan+import           Control.Exception                (bracket)+import           Control.Monad                    (forever, join, unless, void,+                                                   when)+import qualified Data.Aeson.Extended              as A+import           Data.Foldable                    (for_)+import           Data.Functor                     (($>))+import qualified Data.List.NonEmpty               as NonEmpty+import qualified Data.Sequence.Extended           as Seq+import           Data.Version                     (showVersion)+import qualified Options.Applicative              as OA+import qualified Options.Applicative.Help.Pretty  as OA.PP import           Patat.AutoAdvance-import qualified Patat.EncodingFallback          as EncodingFallback-import qualified Patat.Images                    as Images+import qualified Patat.EncodingFallback           as EncodingFallback+import qualified Patat.Images                     as Images import           Patat.Presentation-import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes-import qualified Patat.PrettyPrint               as PP+import qualified Patat.Presentation.Comments      as Comments+import qualified Patat.PrettyPrint                as PP+import           Patat.PrettyPrint.Matrix         (hPutMatrix)+import           Patat.Transition import qualified Paths_patat import           Prelude-import qualified System.Console.ANSI             as Ansi-import           System.Directory                (doesFileExist,-                                                  getModificationTime)-import           System.Exit                     (exitFailure, exitSuccess)-import qualified System.IO                       as IO-import qualified Text.Pandoc                     as Pandoc+import qualified System.Console.ANSI              as Ansi+import           System.Directory                 (doesFileExist,+                                                   getModificationTime)+import           System.Exit                      (exitFailure, exitSuccess)+import qualified System.IO                        as IO+import qualified Text.Pandoc                      as Pandoc   --------------------------------------------------------------------------------@@ -120,6 +124,28 @@   --------------------------------------------------------------------------------+data App = App+    { aOptions      :: Options+    , aImages       :: Maybe Images.Handle+    , aSpeakerNotes :: Maybe Comments.SpeakerNotesHandle+    , aCommandChan  :: Chan AppCommand+    , aPresentation :: Presentation+    , aView         :: AppView+    }+++--------------------------------------------------------------------------------+data AppView+    = PresentationView+    | ErrorView String+    | TransitionView TransitionInstance+++--------------------------------------------------------------------------------+data AppCommand = PresentationCommand PresentationCommand | TransitionTick TransitionId+++-------------------------------------------------------------------------------- main :: IO () main = do     options <- OA.customExecParser parserPrefs parserInfo@@ -137,78 +163,121 @@      errOrPres <- readPresentation filePath     pres      <- either (errorAndExit . return) return errOrPres+    let settings = pSettings pres      unless (oForce options) assertAnsiFeatures -    -- (Maybe) initialize images backend.-    images <- traverse Images.new $ psImages $ pSettings pres+    if oDump options then+        EncodingFallback.withHandle IO.stdout (pEncodingFallback pres) $+        dumpPresentation pres+    else+        -- (Maybe) initialize images backend.+        withMaybeHandle Images.withHandle (psImages settings) $ \images -> -    -- (Maybe) initialize speaker notes.-    withMaybeHandle SpeakerNotes.with-        (psSpeakerNotes $ pSettings pres) $ \speakerNotes ->+        -- (Maybe) initialize speaker notes.+        withMaybeHandle Comments.withSpeakerNotesHandle+            (psSpeakerNotes settings) $ \speakerNotes -> -        if oDump options then-            EncodingFallback.withHandle IO.stdout (pEncodingFallback pres) $-            dumpPresentation pres-        else-            interactiveLoop options images speakerNotes pres-  where-    interactiveLoop-        :: Options -> Maybe Images.Handle -> Maybe SpeakerNotes.Handle-        -> Presentation -> IO ()-    interactiveLoop options images speakerNotes pres0 =-        interactively readPresentationCommand $ \commandChan0 -> do+        -- Read presentation commands+        interactively (readPresentationCommand) $ \commandChan0 ->          -- If an auto delay is set, use 'autoAdvance' to create a new one.-        commandChan <- case psAutoAdvanceDelay (pSettings pres0) of-            Nothing                    -> return commandChan0-            Just (A.FlexibleNum delay) -> autoAdvance delay commandChan0+        maybeAutoAdvance+            (A.unFlexibleNum <$> psAutoAdvanceDelay settings)+            commandChan0 $ \commandChan1 -> +        -- Change to AppCommand+        Chan.withMapChan PresentationCommand commandChan1 $ \commandChan ->+         -- Spawn a thread that adds 'Reload' commands based on the file time.-        mtime0 <- getModificationTime (pFilePath pres0)-        when (oWatch options) $ do-            _ <- forkIO $ watcher commandChan (pFilePath pres0) mtime0-            return ()+        withWatcher (oWatch options) commandChan (pFilePath pres)+            (PresentationCommand Reload) $ -        let loop :: Presentation -> Maybe String -> IO ()-            loop pres mbError = do-                for_ speakerNotes $ \sn -> SpeakerNotes.write sn-                    (pEncodingFallback pres)-                    (activeSpeakerNotes pres)+        loop App+            { aOptions      = options+            , aImages       = images+            , aSpeakerNotes = speakerNotes+            , aCommandChan  = commandChan+            , aPresentation = pres+            , aView         = PresentationView+            } -                size <- getDisplaySize pres-                let display = case mbError of-                        Nothing  -> displayPresentation size pres-                        Just err -> DisplayDoc $-                            displayPresentationError size pres err -                Ansi.clearScreen-                Ansi.setCursorPosition 0 0-                cleanup <- case display of-                    DisplayDoc doc -> EncodingFallback.withHandle-                        IO.stdout (pEncodingFallback pres) $-                        PP.putDoc doc $> mempty-                    DisplayImage path -> case images of-                        Nothing -> do-                            PP.putDoc $ displayPresentationError-                                 size pres "image backend not initialized"-                            pure mempty-                        Just img -> do-                            putStrLn ""-                            IO.hFlush IO.stdout-                            Images.drawImage img path+--------------------------------------------------------------------------------+loop :: App -> IO ()+loop app@App {..} = do+    for_ aSpeakerNotes $ \sn -> Comments.writeSpeakerNotes sn+        (pEncodingFallback aPresentation)+        (activeSpeakerNotes aPresentation) -                c      <- Chan.readChan commandChan-                update <- updatePresentation c pres-                cleanup-                case update of-                    ExitedPresentation        -> return ()-                    UpdatedPresentation pres' -> loop pres' Nothing-                    ErroredPresentation err   -> loop pres (Just err)+    size <- getPresentationSize aPresentation+    Ansi.clearScreen+    Ansi.setCursorPosition 0 0+    cleanup <- case aView of+        PresentationView -> case displayPresentation size aPresentation of+            DisplayDoc doc    -> drawDoc doc+            DisplayImage path -> drawImg size path+        ErrorView err -> drawDoc $+                displayPresentationError size aPresentation err+        TransitionView tr -> do+            drawMatrix (tiSize tr) . fst . NonEmpty.head $ tiFrames tr+            pure mempty -        loop pres0 Nothing+    appCmd <- Chan.readChan aCommandChan+    cleanup+    case appCmd of+        TransitionTick eid -> case aView of+            PresentationView -> loop app+            ErrorView _      -> loop app+            TransitionView tr0  -> case stepTransition eid tr0 of+                Just tr1 -> do+                    scheduleTransitionTick tr1+                    loop app {aView = TransitionView tr1}+                Nothing -> loop app {aView = PresentationView}+        PresentationCommand c -> do+            update <- updatePresentation c aPresentation+            case update of+                ExitedPresentation       -> return ()+                UpdatedPresentation pres+                    | Just tgen <- mbTransition c size aPresentation pres -> do+                        tr <- tgen+                        scheduleTransitionTick tr+                        loop app+                            {aPresentation = pres, aView = TransitionView tr}+                    | otherwise -> loop app+                        {aPresentation = pres, aView = PresentationView}+                ErroredPresentation err  ->+                    loop app {aView = ErrorView err}+  where+    drawDoc doc = EncodingFallback.withHandle+        IO.stdout (pEncodingFallback aPresentation) $+        PP.putDoc doc $> mempty+    drawImg size path =case aImages of+        Nothing -> drawDoc $ displayPresentationError+            size aPresentation "image backend not initialized"+        Just img -> do+            putStrLn ""+            IO.hFlush IO.stdout+            Images.drawImage img path+    drawMatrix size raster = hPutMatrix IO.stdout size raster +    mbTransition c size old new+        | c == Forward+        , oldSlide + 1 == newSlide+        , DisplayDoc oldDoc <- displayPresentation size old+        , DisplayDoc newDoc <- displayPresentation size new+        , Just (Just tgen) <- pTransitionGens new `Seq.safeIndex` newSlide =+            Just $ newTransition tgen size oldDoc newDoc+        | otherwise = Nothing+      where+        (oldSlide, _) = pActiveFragment old+        (newSlide, _) = pActiveFragment new +    scheduleTransitionTick tr = void $ forkIO $ do+        threadDelayDuration . snd . NonEmpty.head $ tiFrames tr+        Chan.writeChan aCommandChan $ TransitionTick $ tiId tr++ -------------------------------------------------------------------------------- -- | Utility for dealing with pecularities of stdin & interactive applications -- on the terminal.  Tries to restore the original state of the terminal as much@@ -221,7 +290,10 @@     -- ^ Application to run.     -> IO ()     -- ^ Returns when application finishes.-interactively reader app = bracket setup teardown $ \(_, _, _, chan) -> app chan+interactively reader app = bracket setup teardown $ \(_, _, chan) ->+    Async.withAsync+        (forever $ reader IO.stdin >>= Chan.writeChan chan)+        (\_ -> app chan)   where     setup = do         chan <- Chan.newChan@@ -230,30 +302,33 @@         IO.hSetEcho      IO.stdin False         IO.hSetBuffering IO.stdin IO.NoBuffering         Ansi.hideCursor-        readerThreadId <- forkIO $ forever $-            reader IO.stdin >>= Chan.writeChan chan-        return (echo, buff, readerThreadId, chan)+        return (echo, buff, chan) -    teardown (echo, buff, readerThreadId, _chan) = do+    teardown (echo, buff, _chan) = do         Ansi.showCursor         Ansi.clearScreen         Ansi.setCursorPosition 0 0-        killThread readerThreadId         IO.hSetEcho      IO.stdin echo         IO.hSetBuffering IO.stdin buff   ---------------------------------------------------------------------------------watcher :: Chan.Chan PresentationCommand -> FilePath -> UTCTime -> IO a-watcher chan filePath mtime0 = do-    -- The extra exists check helps because some editors temporarily make the-    -- file disappear while writing.-    exists <- doesFileExist filePath-    mtime1 <- if exists then getModificationTime filePath else return mtime0+withWatcher+    :: Bool -> Chan.Chan cmd -> FilePath -> cmd -> IO a -> IO a+withWatcher False _    _        _   mx = mx+withWatcher True  chan filePath cmd mx = do+    mtime0 <- getModificationTime filePath+    Async.withAsync (watcher mtime0) (\_ -> mx)+  where+    watcher mtime0 = do+        -- The extra exists check helps because some editors temporarily make+        -- the file disappear while writing.+        exists <- doesFileExist filePath+        mtime1 <- if exists then getModificationTime filePath else return mtime0 -    when (mtime1 > mtime0) $ Chan.writeChan chan Reload-    threadDelay (200 * 1000)-    watcher chan filePath mtime1+        when (mtime1 > mtime0) $ Chan.writeChan chan cmd+        threadDelay (200 * 1000)+        watcher mtime1   --------------------------------------------------------------------------------

@@ -8,7 +8,7 @@     , activeSpeakerNotes      , Size-    , getDisplaySize+    , getPresentationSize      , Display (..)     , displayPresentation

@@ -0,0 +1,174 @@+--------------------------------------------------------------------------------+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TemplateHaskell            #-}+module Patat.Presentation.Comments+    ( Comment (..)+    , parse+    , remove+    , split+    , partition++    , SpeakerNotes+    , speakerNotesToText++    , SpeakerNotesHandle+    , withSpeakerNotesHandle+    , writeSpeakerNotes++    , parseSlideSettings+    ) where+++--------------------------------------------------------------------------------+import           Control.Applicative         ((<|>))+import           Control.Exception           (bracket)+import           Control.Monad               (unless, when)+import           Data.Function               (on)+import qualified Data.IORef                  as IORef+import           Data.List                   (intercalate, intersperse)+import qualified Data.Text                   as T+import qualified Data.Text.Encoding          as T+import qualified Data.Text.IO                as T+import qualified Data.Yaml                   as Yaml+import           Patat.EncodingFallback      (EncodingFallback)+import qualified Patat.EncodingFallback      as EncodingFallback+import           Patat.Presentation.Settings+import           System.Directory            (removeFile)+import qualified System.IO                   as IO+import qualified Text.Pandoc                 as Pandoc+++--------------------------------------------------------------------------------+data Comment = Comment+    { cSpeakerNotes :: SpeakerNotes+    , cConfig       :: Either String PresentationSettings+    } deriving (Show)+++--------------------------------------------------------------------------------+instance Semigroup Comment where+    l <> r = Comment+        { cSpeakerNotes = on (<>) cSpeakerNotes l r+        , cConfig       = case (cConfig l, cConfig r) of+            (Left err, _       ) -> Left err+            (Right _,  Left err) -> Left err+            (Right x,  Right y ) -> Right (x <> y)+        }+++--------------------------------------------------------------------------------+instance Monoid Comment where+    mappend = (<>)+    mempty  = Comment mempty (Right mempty)+++--------------------------------------------------------------------------------+parse :: Pandoc.Block -> Maybe Comment+parse (Pandoc.RawBlock "html" t0) =+    (do+        t1 <- T.stripPrefix "<!--config:" t0+        t2 <- T.stripSuffix "-->" t1+        pure . Comment mempty $ case Yaml.decodeEither' (T.encodeUtf8 t2) of+            Left err  -> Left (show err)+            Right obj -> Right obj) <|>+    (do+        t1 <- T.stripPrefix "<!--" t0+        t2 <- T.stripSuffix "-->" t1+        pure $ Comment (SpeakerNotes [T.strip t2]) (Right mempty))+parse _ = Nothing+++--------------------------------------------------------------------------------+remove :: [Pandoc.Block] -> [Pandoc.Block]+remove = snd . partition+++--------------------------------------------------------------------------------+-- | Take all comments from the front of the list.  Return those and the+-- remaining blocks.+split :: [Pandoc.Block] -> (Comment, [Pandoc.Block])+split = go []+  where+    go sn []                           = (mconcat (reverse sn), [])+    go sn (x : xs) | Just s <- parse x = go (s : sn) xs+    go sn xs                           = (mconcat (reverse sn), xs)+++--------------------------------------------------------------------------------+-- | Partition the list into speaker notes and other blocks.+partition :: [Pandoc.Block] -> (Comment, [Pandoc.Block])+partition = go [] []+  where+    go sn bs []                           = (mconcat (reverse sn), reverse bs)+    go sn bs (x : xs) | Just s <- parse x = go (s : sn) bs xs+    go sn bs (x : xs)                     = go sn (x : bs) xs+++--------------------------------------------------------------------------------+newtype SpeakerNotes = SpeakerNotes [T.Text]+    deriving (Eq, Monoid, Semigroup, Show)+++--------------------------------------------------------------------------------+speakerNotesToText :: SpeakerNotes -> T.Text+speakerNotesToText (SpeakerNotes sn) = T.unlines $ intersperse mempty sn+++--------------------------------------------------------------------------------+data SpeakerNotesHandle = SpeakerNotesHandle+    { snhSettings :: !SpeakerNotesSettings+    , snhActive   :: !(IORef.IORef SpeakerNotes)+    }+++--------------------------------------------------------------------------------+withSpeakerNotesHandle+    :: SpeakerNotesSettings -> (SpeakerNotesHandle -> IO a) -> IO a+withSpeakerNotesHandle settings = bracket+    (SpeakerNotesHandle settings <$> IORef.newIORef mempty)+    (\_ -> removeFile (snsFile settings))+++--------------------------------------------------------------------------------+writeSpeakerNotes+    :: SpeakerNotesHandle -> EncodingFallback -> SpeakerNotes -> IO ()+writeSpeakerNotes h encodingFallback sn = do+    change <- IORef.atomicModifyIORef' (snhActive h) $ \old -> (sn, old /= sn)+    when change $ IO.withFile (snsFile $ snhSettings h) IO.WriteMode $ \ioh ->+        EncodingFallback.withHandle ioh encodingFallback $+        T.hPutStr ioh $ speakerNotesToText sn+++--------------------------------------------------------------------------------+data Setting where+    Setting :: String -> (PresentationSettings -> Maybe a) -> Setting+++--------------------------------------------------------------------------------+unsupportedSlideSettings :: [Setting]+unsupportedSlideSettings =+    [ Setting "incrementalLists" psIncrementalLists+    , Setting "autoAdvanceDelay" psAutoAdvanceDelay+    , Setting "slideLevel"       psSlideLevel+    , Setting "pandocExtensions" psPandocExtensions+    , Setting "images"           psImages+    , Setting "eval"             psEval+    , Setting "speakerNotes"     psSpeakerNotes+    ]+++--------------------------------------------------------------------------------+parseSlideSettings :: Comment -> Either String PresentationSettings+parseSlideSettings c = do+    settings <- cConfig c+    let unsupported = do+            setting <- unsupportedSlideSettings+            case setting of+                Setting name f | Just _ <- f settings -> [name]+                Setting _    _                        -> []+    unless (null unsupported) $ Left $+        "the following settings are not supported in slide config blocks: " +++        intercalate ", " unsupported+    pure settings

@@ -2,10 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-} module Patat.Presentation.Display-    ( Size-    , getDisplaySize--    , Display (..)+    ( Display (..)     , displayPresentation     , displayPresentationError     , dumpPresentation@@ -13,7 +10,7 @@   ---------------------------------------------------------------------------------import           Control.Monad                        (guard, mplus)+import           Control.Monad                        (guard) import qualified Data.Aeson.Extended                  as A import           Data.Char.WCWidth.Extended           (wcstrwidth) import           Data.Data.Extended                   (grecQ)@@ -21,39 +18,22 @@ import           Data.Maybe                           (fromMaybe, maybeToList) import qualified Data.Sequence.Extended               as Seq import qualified Data.Text                            as T+import qualified Patat.Presentation.Comments          as Comments import           Patat.Presentation.Display.CodeBlock import           Patat.Presentation.Display.Internal import           Patat.Presentation.Display.Table import           Patat.Presentation.Internal-import qualified Patat.Presentation.SpeakerNotes      as SpeakerNotes import           Patat.PrettyPrint                    ((<$$>), (<+>)) import qualified Patat.PrettyPrint                    as PP+import           Patat.Size import           Patat.Theme                          (Theme (..)) import qualified Patat.Theme                          as Theme import           Prelude-import qualified System.Console.Terminal.Size         as Terminal import qualified Text.Pandoc.Extended                 as Pandoc import qualified Text.Pandoc.Writers.Shared           as Pandoc   ---------------------------------------------------------------------------------data Size = Size {sRows :: Int, sCols :: Int} deriving (Show)------------------------------------------------------------------------------------getDisplaySize :: Presentation -> IO Size-getDisplaySize Presentation {..} = do-    mbWindow <- Terminal.size-    let sRows = fromMaybe 24 $-            (A.unFlexibleNum <$> psRows pSettings) `mplus`-            (Terminal.height <$> mbWindow)-        sCols = fromMaybe 72 $-            (A.unFlexibleNum <$> psColumns pSettings) `mplus`-            (Terminal.width  <$> mbWindow)-    pure $ Size {..}----------------------------------------------------------------------------------- data Display = DisplayDoc PP.Doc | DisplayImage FilePath deriving (Show)  @@ -62,13 +42,14 @@ -- the active slide number and so on. displayWithBorders     :: Size -> Presentation -> (Size -> DisplaySettings -> PP.Doc) -> PP.Doc-displayWithBorders (Size rows columns) Presentation {..} f =+displayWithBorders (Size rows columns) pres@Presentation {..} f =     (if null title         then mempty         else             let titleRemainder = columns - titleWidth - titleOffset                 wrappedTitle = PP.spaces titleOffset <> PP.string title <> PP.spaces titleRemainder in-        borders wrappedTitle <> PP.hardline <> PP.hardline) <>+        borders wrappedTitle <> PP.hardline) <>+    mconcat (replicate topMargin PP.hardline) <>     formatWith settings (f canvasSize ds) <> PP.hardline <>     PP.goToLine (rows - 2) <>     borders (PP.space <> PP.string author <> middleSpaces <> PP.string active <> PP.space) <>@@ -76,7 +57,7 @@   where     -- Get terminal width/title     (sidx, _)   = pActiveFragment-    settings    = pSettings {psColumns = Just $ A.FlexibleNum columns}+    settings    = (activeSettings pres) {psColumns = Just $ A.FlexibleNum columns}     ds          = DisplaySettings         { dsTheme     = fromMaybe Theme.defaultTheme (psTheme settings)         , dsSyntaxMap = pSyntaxMap@@ -101,7 +82,8 @@     borders     = themed ds themeBorders      -- Room left for content-    canvasSize = Size (rows - 2) columns+    topMargin  = mTop $ margins settings+    canvasSize = Size (rows - 2 - topMargin) columns      -- Compute footer.     active@@ -127,12 +109,12 @@                 prettyFragment theme fragment         Just (ActiveTitle block) -> DisplayDoc $             displayWithBorders size pres $ \canvasSize theme ->-            let pblock          = prettyBlock theme block-                (prows, pcols)  = PP.dimensions pblock-                (mLeft, mRight) = marginsOf pSettings-                offsetRow       = (sRows canvasSize `div` 2) - (prows `div` 2)-                offsetCol       = ((sCols canvasSize - mLeft - mRight) `div` 2) - (pcols `div` 2)-                spaces          = PP.NotTrimmable $ PP.spaces offsetCol in+            let pblock         = prettyBlock theme block+                (prows, pcols) = PP.dimensions pblock+                Margins {..}   = margins (activeSettings pres)+                offsetRow      = (sRows canvasSize `div` 2) - (prows `div` 2)+                offsetCol      = ((sCols canvasSize - mLeft - mRight) `div` 2) - (pcols `div` 2)+                spaces         = PP.NotTrimmable $ PP.spaces offsetCol in             mconcat (replicate (offsetRow - 3) PP.hardline) <$$>             PP.indent spaces spaces pblock @@ -160,44 +142,50 @@ -------------------------------------------------------------------------------- dumpPresentation :: Presentation -> IO () dumpPresentation pres@Presentation {..} =-    PP.putDoc $ PP.removeControls $ formatWith pSettings $+    PP.putDoc $ PP.removeControls $     PP.vcat $ L.intercalate ["{slide}"] $         map dumpSlide [0 .. length pSlides - 1]   where     dumpSlide :: Int -> [PP.Doc]     dumpSlide i = do         slide <- maybeToList $ getSlide i pres-        dumpSpeakerNotes slide <> L.intercalate ["{fragment}"]-            [ dumpFragment (i, j)-            | j <- [0 .. numFragments slide - 1]-            ]+        map (formatWith (getSettings i pres)) $+            dumpComment slide <> L.intercalate ["{fragment}"]+                [ dumpFragment (i, j)+                | j <- [0 .. numFragments slide - 1]+                ] -    dumpSpeakerNotes :: Slide -> [PP.Doc]-    dumpSpeakerNotes slide = do-        guard $ slideSpeakerNotes slide /= mempty+    dumpComment :: Slide -> [PP.Doc]+    dumpComment slide = do+        guard (Comments.cSpeakerNotes comment /= mempty)         pure $ PP.text $ "{speakerNotes: " <>-            SpeakerNotes.toText (slideSpeakerNotes slide) <> "}"+            Comments.speakerNotesToText (Comments.cSpeakerNotes comment) <> "}"+      where+        comment = slideComment slide      dumpFragment :: Index -> [PP.Doc]     dumpFragment idx =-        case displayPresentation size pres {pActiveFragment = idx} of+        case displayPresentation (getSize idx) pres {pActiveFragment = idx} of             DisplayDoc doc        -> [doc]             DisplayImage filepath -> [PP.string $ "{image: " ++ filepath ++ "}"] -    sRows = fromMaybe 24 $ A.unFlexibleNum <$> psRows pSettings-    sCols = fromMaybe 72 $ A.unFlexibleNum <$> psColumns pSettings-    size  = Size {..}+    getSize :: Index -> Size+    getSize idx =+        let settings = activeSettings pres {pActiveFragment = idx}+            sRows    = fromMaybe 24 $ A.unFlexibleNum <$> psRows settings+            sCols    = fromMaybe 72 $ A.unFlexibleNum <$> psColumns settings in+        Size {..}   -------------------------------------------------------------------------------- formatWith :: PresentationSettings -> PP.Doc -> PP.Doc formatWith ps = wrap . indent   where-    (marginLeft, marginRight) = marginsOf ps+    Margins {..} = margins ps     wrap = case (psWrap ps, psColumns ps) of-        (Just True,  Just (A.FlexibleNum col)) -> PP.wrapAt (Just $ col - marginRight)+        (Just True,  Just (A.FlexibleNum col)) -> PP.wrapAt (Just $ col - mRight)         _                                      -> id-    spaces = PP.NotTrimmable $ PP.spaces marginLeft+    spaces = PP.NotTrimmable $ PP.spaces mLeft     indent = PP.indent spaces spaces  

@@ -89,7 +89,6 @@     = UpdatedPresentation !Presentation     | ExitedPresentation     | ErroredPresentation String-    deriving (Show)   --------------------------------------------------------------------------------

@@ -8,8 +8,9 @@     , PresentationSettings (..)     , defaultPresentationSettings +    , MarginSettings (..)     , Margins (..)-    , marginsOf+    , margins      , ExtensionList (..)     , defaultExtensionList@@ -30,29 +31,29 @@     , ActiveFragment (..)     , activeFragment     , activeSpeakerNotes++    , getSettings+    , activeSettings++    , Size+    , getPresentationSize     ) where   ---------------------------------------------------------------------------------import           Control.Monad                   (mplus)-import qualified Data.Aeson.Extended             as A-import qualified Data.Aeson.TH.Extended          as A-import qualified Data.Foldable                   as Foldable-import           Data.Function                   (on)-import qualified Data.HashMap.Strict             as HMS-import           Data.List                       (intercalate)-import           Data.Maybe                      (fromMaybe)-import           Data.Sequence.Extended          (Seq)-import qualified Data.Sequence.Extended          as Seq-import qualified Data.Text                       as T-import           Patat.EncodingFallback          (EncodingFallback)-import qualified Patat.Presentation.Instruction  as Instruction-import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes-import qualified Patat.Theme                     as Theme+import qualified Data.Aeson.Extended            as A+import           Data.Maybe                     (fromMaybe)+import           Data.Sequence.Extended         (Seq)+import qualified Data.Sequence.Extended         as Seq+import           Patat.EncodingFallback         (EncodingFallback)+import qualified Patat.Presentation.Comments    as Comments+import qualified Patat.Presentation.Instruction as Instruction+import           Patat.Presentation.Settings+import           Patat.Size+import           Patat.Transition               (TransitionGen) import           Prelude-import qualified Skylighting                     as Skylighting-import qualified Text.Pandoc                     as Pandoc-import           Text.Read                       (readMaybe)+import qualified Skylighting                    as Skylighting+import qualified Text.Pandoc                    as Pandoc   --------------------------------------------------------------------------------@@ -67,204 +68,37 @@     , pAuthor           :: ![Pandoc.Inline]     , pSettings         :: !PresentationSettings     , pSlides           :: !(Seq Slide)-    , pBreadcrumbs      :: !(Seq Breadcrumbs)  -- One for each slide.+    , pBreadcrumbs      :: !(Seq Breadcrumbs)            -- One for each slide.+    , pSlideSettings    :: !(Seq PresentationSettings)   -- One for each slide.+    , pTransitionGens   :: !(Seq (Maybe TransitionGen))  -- One for each slide.     , pActiveFragment   :: !Index     , pSyntaxMap        :: !Skylighting.SyntaxMap-    } deriving (Show)-------------------------------------------------------------------------------------- | These are patat-specific settings.  That is where they differ from more--- general metadata (author, title...)-data PresentationSettings = PresentationSettings-    { psRows              :: !(Maybe (A.FlexibleNum Int))-    , psColumns           :: !(Maybe (A.FlexibleNum Int))-    , psMargins           :: !(Maybe Margins)-    , psWrap              :: !(Maybe Bool)-    , psTheme             :: !(Maybe Theme.Theme)-    , psIncrementalLists  :: !(Maybe Bool)-    , psAutoAdvanceDelay  :: !(Maybe (A.FlexibleNum Int))-    , psSlideLevel        :: !(Maybe Int)-    , psPandocExtensions  :: !(Maybe ExtensionList)-    , psImages            :: !(Maybe ImageSettings)-    , psBreadcrumbs       :: !(Maybe Bool)-    , psEval              :: !(Maybe EvalSettingsMap)-    , psSlideNumber       :: !(Maybe Bool)-    , psSyntaxDefinitions :: !(Maybe [FilePath])-    , psSpeakerNotes      :: !(Maybe SpeakerNotes.Settings)-    } deriving (Show)------------------------------------------------------------------------------------instance Semigroup PresentationSettings where-    l <> r = PresentationSettings-        { psRows              = on mplus psRows              l r-        , psColumns           = on mplus psColumns           l r-        , psMargins           = on (<>)  psMargins           l r-        , psWrap              = on mplus psWrap              l r-        , psTheme             = on (<>)  psTheme             l r-        , psIncrementalLists  = on mplus psIncrementalLists  l r-        , psAutoAdvanceDelay  = on mplus psAutoAdvanceDelay  l r-        , psSlideLevel        = on mplus psSlideLevel        l r-        , psPandocExtensions  = on mplus psPandocExtensions  l r-        , psImages            = on mplus psImages            l r-        , psBreadcrumbs       = on mplus psBreadcrumbs       l r-        , psEval              = on (<>)  psEval              l r-        , psSlideNumber       = on mplus psSlideNumber       l r-        , psSyntaxDefinitions = on (<>)  psSyntaxDefinitions l r-        , psSpeakerNotes      = on mplus psSpeakerNotes      l r-        }------------------------------------------------------------------------------------instance Monoid PresentationSettings where-    mappend = (<>)-    mempty  = PresentationSettings-                    Nothing Nothing Nothing Nothing Nothing Nothing Nothing-                    Nothing Nothing Nothing Nothing Nothing Nothing Nothing-                    Nothing------------------------------------------------------------------------------------defaultPresentationSettings :: PresentationSettings-defaultPresentationSettings = mempty-    { psMargins          = Just defaultMargins-    , psTheme            = Just Theme.defaultTheme     }   -------------------------------------------------------------------------------- data Margins = Margins-    { mLeft  :: !(Maybe (A.FlexibleNum Int))-    , mRight :: !(Maybe (A.FlexibleNum Int))+    { mTop   :: Int+    , mLeft  :: Int+    , mRight :: Int     } deriving (Show)   ---------------------------------------------------------------------------------instance Semigroup Margins where-    l <> r = Margins-        { mLeft  = mLeft  l `mplus` mLeft  r-        , mRight = mRight l `mplus` mRight r-        }------------------------------------------------------------------------------------instance Monoid Margins where-    mappend = (<>)-    mempty  = Margins Nothing Nothing------------------------------------------------------------------------------------defaultMargins :: Margins-defaultMargins = Margins-    { mLeft  = Nothing-    , mRight = Nothing+margins :: PresentationSettings -> Margins+margins ps = Margins+    { mLeft  = get 0 msLeft+    , mRight = get 0 msRight+    , mTop   = get 1 msTop     }------------------------------------------------------------------------------------marginsOf :: PresentationSettings -> (Int, Int)-marginsOf presentationSettings =-    (marginLeft, marginRight)   where-    margins    = fromMaybe defaultMargins $ psMargins presentationSettings-    marginLeft  = fromMaybe 0 (A.unFlexibleNum <$> mLeft margins)-    marginRight = fromMaybe 0 (A.unFlexibleNum <$> mRight margins)------------------------------------------------------------------------------------newtype ExtensionList = ExtensionList {unExtensionList :: Pandoc.Extensions}-    deriving (Show)------------------------------------------------------------------------------------instance A.FromJSON ExtensionList where-    parseJSON = A.withArray "FromJSON ExtensionList" $-        fmap (ExtensionList . mconcat) . mapM parseExt . Foldable.toList-      where-        parseExt = A.withText "FromJSON ExtensionList" $ \txt -> case txt of-            -- Our default extensions-            "patat_extensions" -> return (unExtensionList defaultExtensionList)--            -- Individuals-            _ -> case readMaybe ("Ext_" ++ T.unpack txt) of-                Just e  -> return $ Pandoc.extensionsFromList [e]-                Nothing -> fail $-                    "Unknown extension: " ++ show txt ++-                    ", known extensions are: " ++-                    intercalate ", " (map (drop 4 . show) allExts)-          where-            -- This is an approximation since we can't enumerate extensions-            -- anymore in the latest pandoc...-            allExts = Pandoc.extensionsToList $-                Pandoc.getAllExtensions "markdown"------------------------------------------------------------------------------------defaultExtensionList :: ExtensionList-defaultExtensionList = ExtensionList $-    Pandoc.readerExtensions Pandoc.def `mappend` Pandoc.extensionsFromList-    [ Pandoc.Ext_yaml_metadata_block-    , Pandoc.Ext_table_captions-    , Pandoc.Ext_simple_tables-    , Pandoc.Ext_multiline_tables-    , Pandoc.Ext_grid_tables-    , Pandoc.Ext_pipe_tables-    , Pandoc.Ext_raw_html-    , Pandoc.Ext_tex_math_dollars-    , Pandoc.Ext_fenced_code_blocks-    , Pandoc.Ext_fenced_code_attributes-    , Pandoc.Ext_backtick_code_blocks-    , Pandoc.Ext_inline_code_attributes-    , Pandoc.Ext_fancy_lists-    , Pandoc.Ext_four_space_rule-    , Pandoc.Ext_definition_lists-    , Pandoc.Ext_compact_definition_lists-    , Pandoc.Ext_example_lists-    , Pandoc.Ext_strikeout-    , Pandoc.Ext_superscript-    , Pandoc.Ext_subscript-    ]------------------------------------------------------------------------------------data ImageSettings = ImageSettings-    { isBackend :: !T.Text-    , isParams  :: !A.Object-    } deriving (Show)------------------------------------------------------------------------------------instance A.FromJSON ImageSettings where-    parseJSON = A.withObject "FromJSON ImageSettings" $ \o -> do-        t <- o A..: "backend"-        return ImageSettings {isBackend = t, isParams = o}------------------------------------------------------------------------------------type EvalSettingsMap = HMS.HashMap T.Text EvalSettings------------------------------------------------------------------------------------data EvalSettings = EvalSettings-    { evalCommand  :: !T.Text-    , evalReplace  :: !Bool-    , evalFragment :: !Bool-    } deriving (Show)------------------------------------------------------------------------------------instance A.FromJSON EvalSettings where-    parseJSON = A.withObject "FromJSON EvalSettings" $ \o -> EvalSettings-        <$> o A..: "command"-        <*> o A..:? "replace" A..!= False-        <*> o A..:? "fragment" A..!= True+    get def f = fromMaybe def . fmap A.unFlexibleNum $ psMargins ps >>= f   -------------------------------------------------------------------------------- data Slide = Slide-    { slideSpeakerNotes :: !SpeakerNotes.SpeakerNotes-    , slideContent      :: !SlideContent+    { slideComment :: !Comments.Comment+    , slideContent :: !SlideContent     } deriving (Show)  @@ -312,13 +146,32 @@   ---------------------------------------------------------------------------------activeSpeakerNotes :: Presentation -> SpeakerNotes.SpeakerNotes+activeSpeakerNotes :: Presentation -> Comments.SpeakerNotes activeSpeakerNotes presentation = fromMaybe mempty $ do     let (sidx, _) = pActiveFragment presentation     slide <- getSlide sidx presentation-    pure $ slideSpeakerNotes slide+    pure . Comments.cSpeakerNotes $ slideComment slide   ---------------------------------------------------------------------------------$(A.deriveFromJSON A.dropPrefixOptions ''Margins)-$(A.deriveFromJSON A.dropPrefixOptions ''PresentationSettings)+getSettings :: Int -> Presentation -> PresentationSettings+getSettings sidx pres =+    fromMaybe mempty (Seq.safeIndex (pSlideSettings pres) sidx) <>+    pSettings pres+++--------------------------------------------------------------------------------+activeSettings :: Presentation -> PresentationSettings+activeSettings pres =+    let (sidx, _) = pActiveFragment pres in getSettings sidx pres+++--------------------------------------------------------------------------------+getPresentationSize :: Presentation -> IO Size+getPresentationSize pres = do+    term <- getTerminalSize+    let rows = fromMaybe (sRows term) $ A.unFlexibleNum <$> psRows settings+        cols = fromMaybe (sCols term) $ A.unFlexibleNum <$> psColumns settings+    pure $ Size {sRows = rows, sCols = cols}+  where+    settings = activeSettings pres

@@ -13,35 +13,37 @@   ---------------------------------------------------------------------------------import           Control.Monad.Except            (ExceptT (..), runExceptT,-                                                  throwError)-import           Control.Monad.Trans             (liftIO)-import qualified Data.Aeson                      as A-import qualified Data.Aeson.KeyMap               as AKM-import           Data.Bifunctor                  (first)-import           Data.Maybe                      (fromMaybe)-import           Data.Sequence.Extended          (Seq)-import qualified Data.Sequence.Extended          as Seq-import qualified Data.Text                       as T-import qualified Data.Text.Encoding              as T-import qualified Data.Yaml                       as Yaml-import           Patat.EncodingFallback          (EncodingFallback)-import qualified Patat.EncodingFallback          as EncodingFallback-import           Patat.Eval                      (eval)+import           Control.Monad.Except           (ExceptT (..), runExceptT,+                                                 throwError)+import           Control.Monad.Trans            (liftIO)+import qualified Data.Aeson                     as A+import qualified Data.Aeson.KeyMap              as AKM+import           Data.Bifunctor                 (first)+import           Data.Maybe                     (fromMaybe)+import           Data.Sequence.Extended         (Seq)+import qualified Data.Sequence.Extended         as Seq+import qualified Data.Text                      as T+import qualified Data.Text.Encoding             as T+import           Data.Traversable               (for)+import qualified Data.Yaml                      as Yaml+import           Patat.EncodingFallback         (EncodingFallback)+import qualified Patat.EncodingFallback         as EncodingFallback+import           Patat.Eval                     (eval)+import qualified Patat.Presentation.Comments    as Comments import           Patat.Presentation.Fragment-import qualified Patat.Presentation.Instruction  as Instruction+import qualified Patat.Presentation.Instruction as Instruction import           Patat.Presentation.Internal-import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes+import           Patat.Transition               (parseTransitionSettings) import           Prelude-import qualified Skylighting                     as Skylighting-import           System.Directory                (XdgDirectory (XdgConfig),-                                                  doesFileExist,-                                                  getHomeDirectory,-                                                  getXdgDirectory)-import           System.FilePath                 (splitFileName, takeExtension,-                                                  (</>))-import qualified Text.Pandoc.Error               as Pandoc-import qualified Text.Pandoc.Extended            as Pandoc+import qualified Skylighting                    as Skylighting+import           System.Directory               (XdgDirectory (XdgConfig),+                                                 doesFileExist,+                                                 getHomeDirectory,+                                                 getXdgDirectory)+import           System.FilePath                (splitFileName, takeExtension,+                                                 (</>))+import qualified Text.Pandoc.Error              as Pandoc+import qualified Text.Pandoc.Extended           as Pandoc   --------------------------------------------------------------------------------@@ -131,6 +133,15 @@         !pBreadcrumbs    = collectBreadcrumbs pSlides         !pActiveFragment = (0, 0)         !pAuthor         = concat (Pandoc.docAuthors meta)+    pSlideSettings <- Seq.traverseWithIndex+        (\i ->+            first (\err -> "on slide " ++ show (i + 1) ++ ": " ++ err) .+            Comments.parseSlideSettings . slideComment)+        pSlides+    pTransitionGens <- for pSlideSettings $ \slideSettings ->+        case psTransition (slideSettings <> pSettings) of+            Nothing -> pure Nothing+            Just ts -> Just <$> parseTransitionSettings ts     return Presentation {..}  @@ -217,7 +228,7 @@ -- header that occurs before a non-header in the blocks. detectSlideLevel :: Pandoc.Pandoc -> Int detectSlideLevel (Pandoc.Pandoc _meta blocks0) =-    go 6 $ SpeakerNotes.remove blocks0+    go 6 $ Comments.remove blocks0   where     go level (Pandoc.Header n _ _ : x : xs)         | n < level && not (isHeader x) = go n xs@@ -240,7 +251,7 @@     | otherwise                              = splitAtHeaders [] blocks0   where     mkContentSlide :: [Pandoc.Block] -> [Slide]-    mkContentSlide bs0 = case SpeakerNotes.partition bs0 of+    mkContentSlide bs0 = case Comments.partition bs0 of         (_,  [])  -> [] -- Never create empty slides         (sn, bs1) -> pure . Slide sn . ContentSlide $             Instruction.fromList [Instruction.Append bs1]@@ -256,7 +267,7 @@         | i == slideLevel =             mkContentSlide (reverse acc) ++ splitAtHeaders [b] bs0         | otherwise       =-            let (sn, bs1) = SpeakerNotes.split bs0 in+            let (sn, bs1) = Comments.split bs0 in             mkContentSlide (reverse acc) ++             [Slide sn $ TitleSlide i txt] ++             splitAtHeaders [] bs1

@@ -0,0 +1,236 @@+--------------------------------------------------------------------------------+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TemplateHaskell            #-}+module Patat.Presentation.Settings+    ( PresentationSettings (..)+    , defaultPresentationSettings++    , MarginSettings (..)++    , ExtensionList (..)+    , defaultExtensionList++    , ImageSettings (..)++    , EvalSettingsMap+    , EvalSettings (..)++    , SpeakerNotesSettings (..)++    , TransitionSettings (..)+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad                  (mplus)+import qualified Data.Aeson.Extended            as A+import qualified Data.Aeson.TH.Extended         as A+import qualified Data.Foldable                  as Foldable+import           Data.Function                  (on)+import qualified Data.HashMap.Strict            as HMS+import           Data.List                      (intercalate)+import qualified Data.Text                      as T+import qualified Patat.Theme                    as Theme+import           Prelude+import qualified Text.Pandoc                    as Pandoc+import           Text.Read                      (readMaybe)+++--------------------------------------------------------------------------------+-- | These are patat-specific settings.  That is where they differ from more+-- general metadata (author, title...)+data PresentationSettings = PresentationSettings+    { psRows              :: !(Maybe (A.FlexibleNum Int))+    , psColumns           :: !(Maybe (A.FlexibleNum Int))+    , psMargins           :: !(Maybe MarginSettings)+    , psWrap              :: !(Maybe Bool)+    , psTheme             :: !(Maybe Theme.Theme)+    , psIncrementalLists  :: !(Maybe Bool)+    , psAutoAdvanceDelay  :: !(Maybe (A.FlexibleNum Int))+    , psSlideLevel        :: !(Maybe Int)+    , psPandocExtensions  :: !(Maybe ExtensionList)+    , psImages            :: !(Maybe ImageSettings)+    , psBreadcrumbs       :: !(Maybe Bool)+    , psEval              :: !(Maybe EvalSettingsMap)+    , psSlideNumber       :: !(Maybe Bool)+    , psSyntaxDefinitions :: !(Maybe [FilePath])+    , psSpeakerNotes      :: !(Maybe SpeakerNotesSettings)+    , psTransition        :: !(Maybe TransitionSettings)+    } deriving (Show)+++--------------------------------------------------------------------------------+instance Semigroup PresentationSettings where+    l <> r = PresentationSettings+        { psRows              = on mplus psRows              l r+        , psColumns           = on mplus psColumns           l r+        , psMargins           = on (<>)  psMargins           l r+        , psWrap              = on mplus psWrap              l r+        , psTheme             = on (<>)  psTheme             l r+        , psIncrementalLists  = on mplus psIncrementalLists  l r+        , psAutoAdvanceDelay  = on mplus psAutoAdvanceDelay  l r+        , psSlideLevel        = on mplus psSlideLevel        l r+        , psPandocExtensions  = on mplus psPandocExtensions  l r+        , psImages            = on mplus psImages            l r+        , psBreadcrumbs       = on mplus psBreadcrumbs       l r+        , psEval              = on (<>)  psEval              l r+        , psSlideNumber       = on mplus psSlideNumber       l r+        , psSyntaxDefinitions = on (<>)  psSyntaxDefinitions l r+        , psSpeakerNotes      = on mplus psSpeakerNotes      l r+        , psTransition        = on mplus psTransition        l r+        }+++--------------------------------------------------------------------------------+instance Monoid PresentationSettings where+    mappend = (<>)+    mempty  = PresentationSettings+                    Nothing Nothing Nothing Nothing Nothing Nothing Nothing+                    Nothing Nothing Nothing Nothing Nothing Nothing Nothing+                    Nothing Nothing+++--------------------------------------------------------------------------------+defaultPresentationSettings :: PresentationSettings+defaultPresentationSettings = mempty+    { psMargins = Nothing+    , psTheme   = Just Theme.defaultTheme+    }+++--------------------------------------------------------------------------------+data MarginSettings = MarginSettings+    { msTop   :: !(Maybe (A.FlexibleNum Int))+    , msLeft  :: !(Maybe (A.FlexibleNum Int))+    , msRight :: !(Maybe (A.FlexibleNum Int))+    } deriving (Show)+++--------------------------------------------------------------------------------+instance Semigroup MarginSettings where+    l <> r = MarginSettings+        { msTop   = on mplus msTop   l r+        , msLeft  = on mplus msLeft  l r+        , msRight = on mplus msRight l r+        }+++--------------------------------------------------------------------------------+instance Monoid MarginSettings where+    mappend = (<>)+    mempty  = MarginSettings Nothing Nothing Nothing+++--------------------------------------------------------------------------------+newtype ExtensionList = ExtensionList {unExtensionList :: Pandoc.Extensions}+    deriving (Show)+++--------------------------------------------------------------------------------+instance A.FromJSON ExtensionList where+    parseJSON = A.withArray "FromJSON ExtensionList" $+        fmap (ExtensionList . mconcat) . mapM parseExt . Foldable.toList+      where+        parseExt = A.withText "FromJSON ExtensionList" $ \txt -> case txt of+            -- Our default extensions+            "patat_extensions" -> return (unExtensionList defaultExtensionList)++            -- Individuals+            _ -> case readMaybe ("Ext_" ++ T.unpack txt) of+                Just e  -> return $ Pandoc.extensionsFromList [e]+                Nothing -> fail $+                    "Unknown extension: " ++ show txt +++                    ", known extensions are: " +++                    intercalate ", " (map (drop 4 . show) allExts)+          where+            -- This is an approximation since we can't enumerate extensions+            -- anymore in the latest pandoc...+            allExts = Pandoc.extensionsToList $+                Pandoc.getAllExtensions "markdown"+++--------------------------------------------------------------------------------+defaultExtensionList :: ExtensionList+defaultExtensionList = ExtensionList $+    Pandoc.readerExtensions Pandoc.def `mappend` Pandoc.extensionsFromList+    [ Pandoc.Ext_yaml_metadata_block+    , Pandoc.Ext_table_captions+    , Pandoc.Ext_simple_tables+    , Pandoc.Ext_multiline_tables+    , Pandoc.Ext_grid_tables+    , Pandoc.Ext_pipe_tables+    , Pandoc.Ext_raw_html+    , Pandoc.Ext_tex_math_dollars+    , Pandoc.Ext_fenced_code_blocks+    , Pandoc.Ext_fenced_code_attributes+    , Pandoc.Ext_backtick_code_blocks+    , Pandoc.Ext_inline_code_attributes+    , Pandoc.Ext_fancy_lists+    , Pandoc.Ext_four_space_rule+    , Pandoc.Ext_definition_lists+    , Pandoc.Ext_compact_definition_lists+    , Pandoc.Ext_example_lists+    , Pandoc.Ext_strikeout+    , Pandoc.Ext_superscript+    , Pandoc.Ext_subscript+    ]+++--------------------------------------------------------------------------------+data ImageSettings = ImageSettings+    { isBackend :: !T.Text+    , isParams  :: !A.Object+    } deriving (Show)+++--------------------------------------------------------------------------------+instance A.FromJSON ImageSettings where+    parseJSON = A.withObject "FromJSON ImageSettings" $ \o -> do+        t <- o A..: "backend"+        return ImageSettings {isBackend = t, isParams = o}+++--------------------------------------------------------------------------------+type EvalSettingsMap = HMS.HashMap T.Text EvalSettings+++--------------------------------------------------------------------------------+data EvalSettings = EvalSettings+    { evalCommand  :: !T.Text+    , evalReplace  :: !Bool+    , evalFragment :: !Bool+    } deriving (Show)+++--------------------------------------------------------------------------------+instance A.FromJSON EvalSettings where+    parseJSON = A.withObject "FromJSON EvalSettings" $ \o -> EvalSettings+        <$> o A..: "command"+        <*> o A..:? "replace" A..!= False+        <*> o A..:? "fragment" A..!= True+++--------------------------------------------------------------------------------+data SpeakerNotesSettings = SpeakerNotesSettings+    { snsFile :: !FilePath+    } deriving (Show)+++--------------------------------------------------------------------------------+data TransitionSettings = TransitionSettings+    { tsType   :: !T.Text+    , tsParams :: !A.Object+    } deriving (Show)+++--------------------------------------------------------------------------------+instance A.FromJSON TransitionSettings where+    parseJSON = A.withObject "FromJSON TransitionSettings" $ \o ->+        TransitionSettings <$> o A..: "type" <*> pure o+++--------------------------------------------------------------------------------+$(A.deriveFromJSON A.dropPrefixOptions ''MarginSettings)+$(A.deriveFromJSON A.dropPrefixOptions ''SpeakerNotesSettings)+$(A.deriveFromJSON A.dropPrefixOptions ''PresentationSettings)

@@ -1,110 +0,0 @@----------------------------------------------------------------------------------{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE TemplateHaskell            #-}-module Patat.Presentation.SpeakerNotes-    ( SpeakerNotes-    , parse-    , toText-    , remove-    , split-    , partition--    , Settings-    , Handle-    , with-    , write-    ) where------------------------------------------------------------------------------------import           Control.Exception      (bracket)-import           Control.Monad          (when)-import qualified Data.Aeson.TH.Extended as A-import qualified Data.IORef             as IORef-import           Data.List              (intersperse)-import qualified Data.Text              as T-import qualified Data.Text.IO           as T-import           Patat.EncodingFallback (EncodingFallback)-import qualified Patat.EncodingFallback as EncodingFallback-import           System.Directory       (removeFile)-import qualified System.IO              as IO-import qualified Text.Pandoc            as Pandoc------------------------------------------------------------------------------------newtype SpeakerNotes = SpeakerNotes [T.Text]-    deriving (Eq, Monoid, Semigroup, Show)------------------------------------------------------------------------------------parse :: Pandoc.Block -> Maybe SpeakerNotes-parse (Pandoc.RawBlock "html" t0) = do-    t1 <- T.stripPrefix "<!--" t0-    t2 <- T.stripSuffix "-->" t1-    pure $ SpeakerNotes [T.strip t2]-parse _ = Nothing------------------------------------------------------------------------------------toText :: SpeakerNotes -> T.Text-toText (SpeakerNotes sn) = T.unlines $ intersperse mempty sn------------------------------------------------------------------------------------remove :: [Pandoc.Block] -> [Pandoc.Block]-remove = snd . partition-------------------------------------------------------------------------------------- | Take all speaker notes from the front of the list.  Return those and the--- remaining blocks.-split :: [Pandoc.Block] -> (SpeakerNotes, [Pandoc.Block])-split = go []-  where-    go sn []                           = (mconcat (reverse sn), [])-    go sn (x : xs) | Just s <- parse x = go (s : sn) xs-    go sn xs                           = (mconcat (reverse sn), xs)-------------------------------------------------------------------------------------- | Partition the list into speaker notes and other blocks.-partition :: [Pandoc.Block] -> (SpeakerNotes, [Pandoc.Block])-partition = go [] []-  where-    go sn bs []                           = (mconcat (reverse sn), reverse bs)-    go sn bs (x : xs) | Just s <- parse x = go (s : sn) bs xs-    go sn bs (x : xs)                     = go sn (x : bs) xs------------------------------------------------------------------------------------data Settings = Settings-    { sFile :: !FilePath-    } deriving (Show)------------------------------------------------------------------------------------data Handle = Handle-    { hSettings :: !Settings-    , hActive   :: !(IORef.IORef SpeakerNotes)-    }------------------------------------------------------------------------------------with :: Settings -> (Handle -> IO a) -> IO a-with settings = bracket-    (Handle settings <$> IORef.newIORef mempty)-    (\_ -> removeFile (sFile settings))------------------------------------------------------------------------------------write :: Handle -> EncodingFallback -> SpeakerNotes -> IO ()-write h encodingFallback sn = do-    change <- IORef.atomicModifyIORef' (hActive h) $ \old -> (sn, old /= sn)-    when change $ IO.withFile (sFile $ hSettings h) IO.WriteMode $ \ioh ->-        EncodingFallback.withHandle ioh encodingFallback $-        T.hPutStr ioh $ toText sn------------------------------------------------------------------------------------$(A.deriveFromJSON A.dropPrefixOptions ''Settings)

@@ -14,6 +14,7 @@     , hPutDoc     , putDoc +    , char     , string     , text     , space@@ -46,292 +47,17 @@   ---------------------------------------------------------------------------------import           Control.Monad.Reader       (asks, local)-import           Control.Monad.RWS          (RWS, runRWS)-import           Control.Monad.State        (get, gets, modify)-import           Control.Monad.Writer       (tell) import           Data.Char.WCWidth.Extended (wcstrwidth) import qualified Data.List                  as L-import           Data.String                (IsString (..)) import qualified Data.Text                  as T+import           Patat.PrettyPrint.Internal import           Prelude                    hiding (null) import qualified System.Console.ANSI        as Ansi-import qualified System.IO                  as IO   ----------------------------------------------------------------------------------- | Control actions for the terminal.-data Control-    = ClearScreenControl-    | GoToLineControl Int-    deriving (Eq)-------------------------------------------------------------------------------------- | A simple chunk of text.  All ANSI codes are "reset" after printing.-data Chunk-    = StringChunk [Ansi.SGR] String-    | NewlineChunk-    | ControlChunk Control-    deriving (Eq)------------------------------------------------------------------------------------type Chunks = [Chunk]------------------------------------------------------------------------------------hPutChunk :: IO.Handle -> Chunk -> IO ()-hPutChunk h NewlineChunk = IO.hPutStrLn h ""-hPutChunk h (StringChunk codes str) = do-    Ansi.hSetSGR h (reverse codes)-    IO.hPutStr h str-    Ansi.hSetSGR h [Ansi.Reset]-hPutChunk h (ControlChunk ctrl) = case ctrl of-    ClearScreenControl -> Ansi.hClearScreen h-    GoToLineControl l  -> Ansi.hSetCursorPosition h l 0------------------------------------------------------------------------------------chunkToString :: Chunk -> String-chunkToString NewlineChunk        = "\n"-chunkToString (StringChunk _ str) = str-chunkToString (ControlChunk _)    = ""-------------------------------------------------------------------------------------- | If two neighboring chunks have the same set of ANSI codes, we can group--- them together.-optimizeChunks :: Chunks -> Chunks-optimizeChunks (StringChunk c1 s1 : StringChunk c2 s2 : chunks)-    | c1 == c2  = optimizeChunks (StringChunk c1 (s1 <> s2) : chunks)-    | otherwise =-        StringChunk c1 s1 : optimizeChunks (StringChunk c2 s2 : chunks)-optimizeChunks (x : chunks) = x : optimizeChunks chunks-optimizeChunks [] = []------------------------------------------------------------------------------------chunkLines :: Chunks -> [Chunks]-chunkLines chunks = case break (== NewlineChunk) chunks of-    (xs, _newline : ys) -> xs : chunkLines ys-    (xs, [])            -> [xs]------------------------------------------------------------------------------------data DocE d-    = String String-    | Softspace-    | Hardspace-    | Softline-    | Hardline-    | WrapAt-        { wrapAtCol :: Maybe Int-        , wrapDoc   :: d-        }-    | Ansi-        { ansiCode :: [Ansi.SGR] -> [Ansi.SGR]  -- ^ Modifies current codes.-        , ansiDoc  :: d-        }-    | Indent-        { indentFirstLine  :: LineBuffer-        , indentOtherLines :: LineBuffer-        , indentDoc        :: d-        }-    | Control Control-    deriving (Functor)------------------------------------------------------------------------------------chunkToDocE :: Chunk -> DocE Doc-chunkToDocE NewlineChunk         = Hardline-chunkToDocE (StringChunk c1 str) = Ansi (\c0 -> c1 ++ c0) (Doc [String str])-chunkToDocE (ControlChunk ctrl)  = Control ctrl------------------------------------------------------------------------------------newtype Doc = Doc {unDoc :: [DocE Doc]}-    deriving (Monoid, Semigroup)------------------------------------------------------------------------------------instance IsString Doc where-    fromString = string------------------------------------------------------------------------------------instance Show Doc where-    show = toString------------------------------------------------------------------------------------data DocEnv = DocEnv-    { deCodes  :: [Ansi.SGR]  -- ^ Most recent ones first in the list-    , deIndent :: LineBuffer  -- ^ Don't need to store first-line indent-    , deWrap   :: Maybe Int   -- ^ Wrap at columns-    }------------------------------------------------------------------------------------type DocM = RWS DocEnv Chunks LineBuffer------------------------------------------------------------------------------------data Trimmable a-    = NotTrimmable !a-    | Trimmable    !a-    deriving (Foldable, Functor, Traversable)-------------------------------------------------------------------------------------- | Note that this is reversed so we have fast append-type LineBuffer = [Trimmable Chunk]------------------------------------------------------------------------------------bufferToChunks :: LineBuffer -> Chunks-bufferToChunks = map trimmableToChunk . reverse . dropWhile isTrimmable-  where-    isTrimmable (NotTrimmable _) = False-    isTrimmable (Trimmable    _) = True--    trimmableToChunk (NotTrimmable c) = c-    trimmableToChunk (Trimmable    c) = c------------------------------------------------------------------------------------docToChunks :: Doc -> Chunks-docToChunks doc0 =-    let env0        = DocEnv [] [] Nothing-        ((), b, cs) = runRWS (go $ unDoc doc0) env0 mempty in-    optimizeChunks (cs <> bufferToChunks b)-  where-    go :: [DocE Doc] -> DocM ()--    go [] = return ()--    go (String str : docs) = do-        chunk <- makeChunk str-        modify (NotTrimmable chunk :)-        go docs--    go (Softspace : docs) = do-        hard <- softConversion Softspace docs-        go (hard : docs)--    go (Hardspace : docs) = do-        chunk <- makeChunk " "-        modify (NotTrimmable chunk :)-        go docs--    go (Softline : docs) = do-        hard <- softConversion Softline docs-        go (hard : docs)--    go (Hardline : docs) = do-        buffer <- get-        tell $ bufferToChunks buffer <> [NewlineChunk]-        indentation <- asks deIndent-        modify $ \_ -> if L.null docs then [] else indentation-        go docs--    go (WrapAt {..} : docs) = do-        local (\env -> env {deWrap = wrapAtCol}) $ go (unDoc wrapDoc)-        go docs--    go (Ansi {..} : docs) = do-        local (\env -> env {deCodes = ansiCode (deCodes env)}) $-            go (unDoc ansiDoc)-        go docs--    go (Indent {..} : docs) = do-        local (\env -> env {deIndent = indentOtherLines ++ deIndent env}) $ do-            modify (indentFirstLine ++)-            go (unDoc indentDoc)-        go docs--    go (Control ctrl : docs) = do-        tell [ControlChunk ctrl]-        go docs---    makeChunk :: String -> DocM Chunk-    makeChunk str = do-        codes <- asks deCodes-        return $ StringChunk codes str--    -- Convert 'Softspace' or 'Softline' to 'Hardspace' or 'Hardline'-    softConversion :: DocE Doc -> [DocE Doc] -> DocM (DocE Doc)-    softConversion soft docs = do-        mbWrapCol <- asks deWrap-        case mbWrapCol of-            Nothing     -> return hard-            Just maxCol -> do-                -- Slow.-                currentLine <- gets (concatMap chunkToString . bufferToChunks)-                let currentCol = wcstrwidth currentLine-                case nextWordLength docs of-                    Nothing                            -> return hard-                    Just l-                        | currentCol + 1 + l <= maxCol -> return Hardspace-                        | otherwise                    -> return Hardline-      where-        hard = case soft of-            Softspace -> Hardspace-            Softline  -> Hardline-            _         -> soft--    nextWordLength :: [DocE Doc] -> Maybe Int-    nextWordLength []                 = Nothing-    nextWordLength (String x : xs)-        | L.null x                    = nextWordLength xs-        | otherwise                   = Just (wcstrwidth x)-    nextWordLength (Softspace : xs)   = nextWordLength xs-    nextWordLength (Hardspace : xs)   = nextWordLength xs-    nextWordLength (Softline : xs)    = nextWordLength xs-    nextWordLength (Hardline : _)     = Nothing-    nextWordLength (WrapAt {..} : xs) = nextWordLength (unDoc wrapDoc   ++ xs)-    nextWordLength (Ansi   {..} : xs) = nextWordLength (unDoc ansiDoc   ++ xs)-    nextWordLength (Indent {..} : xs) = nextWordLength (unDoc indentDoc ++ xs)-    nextWordLength (Control _ : _)    = Nothing------------------------------------------------------------------------------------toString :: Doc -> String-toString = concat . map chunkToString . docToChunks-------------------------------------------------------------------------------------- | Returns the rows and columns necessary to render this document-dimensions :: Doc -> (Int, Int)-dimensions doc =-    let ls = lines (toString doc) in-    (length ls, foldr max 0 (map wcstrwidth ls))------------------------------------------------------------------------------------null :: Doc -> Bool-null doc = case unDoc doc of [] -> True; _ -> False------------------------------------------------------------------------------------hPutDoc :: IO.Handle -> Doc -> IO ()-hPutDoc h = mapM_ (hPutChunk h) . docToChunks------------------------------------------------------------------------------------putDoc :: Doc -> IO ()-putDoc = hPutDoc IO.stdout------------------------------------------------------------------------------------mkDoc :: DocE Doc -> Doc-mkDoc e = Doc [e]------------------------------------------------------------------------------------string :: String -> Doc-string = mkDoc . String  -- TODO (jaspervdj): Newline conversion+char :: Char -> Doc+char = string . pure   --------------------------------------------------------------------------------

@@ -0,0 +1,319 @@+--------------------------------------------------------------------------------+-- | This is a small pretty-printing library.+{-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE DeriveTraversable          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RecordWildCards            #-}+module Patat.PrettyPrint.Internal+    ( Control (..)+    , Chunk (..)+    , Chunks+    , chunkToString+    , chunkLines++    , DocE (..)+    , chunkToDocE++    , Doc (..)+    , docToChunks++    , Trimmable (..)++    , toString+    , dimensions+    , null++    , hPutDoc+    , putDoc+    , mkDoc+    , string+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad.Reader       (asks, local)+import           Control.Monad.RWS          (RWS, runRWS)+import           Control.Monad.State        (get, gets, modify)+import           Control.Monad.Writer       (tell)+import           Data.Char.WCWidth.Extended (wcstrwidth)+import qualified Data.List                  as L+import           Data.String                (IsString (..))+import           Prelude                    hiding (null)+import qualified System.Console.ANSI        as Ansi+import qualified System.IO                  as IO+++--------------------------------------------------------------------------------+-- | Control actions for the terminal.+data Control+    = ClearScreenControl+    | GoToLineControl Int+    deriving (Eq)+++--------------------------------------------------------------------------------+-- | A simple chunk of text.  All ANSI codes are "reset" after printing.+data Chunk+    = StringChunk [Ansi.SGR] String+    | NewlineChunk+    | ControlChunk Control+    deriving (Eq)+++--------------------------------------------------------------------------------+type Chunks = [Chunk]+++--------------------------------------------------------------------------------+hPutChunk :: IO.Handle -> Chunk -> IO ()+hPutChunk h NewlineChunk = IO.hPutStrLn h ""+hPutChunk h (StringChunk codes str) = do+    Ansi.hSetSGR h (reverse codes)+    IO.hPutStr h str+    Ansi.hSetSGR h [Ansi.Reset]+hPutChunk h (ControlChunk ctrl) = case ctrl of+    ClearScreenControl -> Ansi.hClearScreen h+    GoToLineControl l  -> Ansi.hSetCursorPosition h l 0+++--------------------------------------------------------------------------------+chunkToString :: Chunk -> String+chunkToString NewlineChunk        = "\n"+chunkToString (StringChunk _ str) = str+chunkToString (ControlChunk _)    = ""+++--------------------------------------------------------------------------------+-- | If two neighboring chunks have the same set of ANSI codes, we can group+-- them together.+optimizeChunks :: Chunks -> Chunks+optimizeChunks (StringChunk c1 s1 : StringChunk c2 s2 : chunks)+    | c1 == c2  = optimizeChunks (StringChunk c1 (s1 <> s2) : chunks)+    | otherwise =+        StringChunk c1 s1 : optimizeChunks (StringChunk c2 s2 : chunks)+optimizeChunks (x : chunks) = x : optimizeChunks chunks+optimizeChunks [] = []+++--------------------------------------------------------------------------------+chunkLines :: Chunks -> [Chunks]+chunkLines chunks = case break (== NewlineChunk) chunks of+    (xs, _newline : ys) -> xs : chunkLines ys+    (xs, [])            -> [xs]+++--------------------------------------------------------------------------------+data DocE d+    = String String+    | Softspace+    | Hardspace+    | Softline+    | Hardline+    | WrapAt+        { wrapAtCol :: Maybe Int+        , wrapDoc   :: d+        }+    | Ansi+        { ansiCode :: [Ansi.SGR] -> [Ansi.SGR]  -- ^ Modifies current codes.+        , ansiDoc  :: d+        }+    | Indent+        { indentFirstLine  :: LineBuffer+        , indentOtherLines :: LineBuffer+        , indentDoc        :: d+        }+    | Control Control+    deriving (Functor)+++--------------------------------------------------------------------------------+chunkToDocE :: Chunk -> DocE Doc+chunkToDocE NewlineChunk         = Hardline+chunkToDocE (StringChunk c1 str) = Ansi (\c0 -> c1 ++ c0) (Doc [String str])+chunkToDocE (ControlChunk ctrl)  = Control ctrl+++--------------------------------------------------------------------------------+newtype Doc = Doc {unDoc :: [DocE Doc]}+    deriving (Monoid, Semigroup)+++--------------------------------------------------------------------------------+instance Show Doc where+    show = toString+++--------------------------------------------------------------------------------+instance IsString Doc where+    fromString = string+++--------------------------------------------------------------------------------+data DocEnv = DocEnv+    { deCodes  :: [Ansi.SGR]  -- ^ Most recent ones first in the list+    , deIndent :: LineBuffer  -- ^ Don't need to store first-line indent+    , deWrap   :: Maybe Int   -- ^ Wrap at columns+    }+++--------------------------------------------------------------------------------+type DocM = RWS DocEnv Chunks LineBuffer+++--------------------------------------------------------------------------------+data Trimmable a+    = NotTrimmable !a+    | Trimmable    !a+    deriving (Foldable, Functor, Traversable)+++--------------------------------------------------------------------------------+-- | Note that this is reversed so we have fast append+type LineBuffer = [Trimmable Chunk]+++--------------------------------------------------------------------------------+bufferToChunks :: LineBuffer -> Chunks+bufferToChunks = map trimmableToChunk . reverse . dropWhile isTrimmable+  where+    isTrimmable (NotTrimmable _) = False+    isTrimmable (Trimmable    _) = True++    trimmableToChunk (NotTrimmable c) = c+    trimmableToChunk (Trimmable    c) = c+++--------------------------------------------------------------------------------+docToChunks :: Doc -> Chunks+docToChunks doc0 =+    let env0        = DocEnv [] [] Nothing+        ((), b, cs) = runRWS (go $ unDoc doc0) env0 mempty in+    optimizeChunks (cs <> bufferToChunks b)+  where+    go :: [DocE Doc] -> DocM ()++    go [] = return ()++    go (String str : docs) = do+        chunk <- makeChunk str+        modify (NotTrimmable chunk :)+        go docs++    go (Softspace : docs) = do+        hard <- softConversion Softspace docs+        go (hard : docs)++    go (Hardspace : docs) = do+        chunk <- makeChunk " "+        modify (NotTrimmable chunk :)+        go docs++    go (Softline : docs) = do+        hard <- softConversion Softline docs+        go (hard : docs)++    go (Hardline : docs) = do+        buffer <- get+        tell $ bufferToChunks buffer <> [NewlineChunk]+        indentation <- asks deIndent+        modify $ \_ -> if L.null docs then [] else indentation+        go docs++    go (WrapAt {..} : docs) = do+        local (\env -> env {deWrap = wrapAtCol}) $ go (unDoc wrapDoc)+        go docs++    go (Ansi {..} : docs) = do+        local (\env -> env {deCodes = ansiCode (deCodes env)}) $+            go (unDoc ansiDoc)+        go docs++    go (Indent {..} : docs) = do+        local (\env -> env {deIndent = indentOtherLines ++ deIndent env}) $ do+            modify (indentFirstLine ++)+            go (unDoc indentDoc)+        go docs++    go (Control ctrl : docs) = do+        tell [ControlChunk ctrl]+        go docs+++    makeChunk :: String -> DocM Chunk+    makeChunk str = do+        codes <- asks deCodes+        return $ StringChunk codes str++    -- Convert 'Softspace' or 'Softline' to 'Hardspace' or 'Hardline'+    softConversion :: DocE Doc -> [DocE Doc] -> DocM (DocE Doc)+    softConversion soft docs = do+        mbWrapCol <- asks deWrap+        case mbWrapCol of+            Nothing     -> return hard+            Just maxCol -> do+                -- Slow.+                currentLine <- gets (concatMap chunkToString . bufferToChunks)+                let currentCol = wcstrwidth currentLine+                case nextWordLength docs of+                    Nothing                            -> return hard+                    Just l+                        | currentCol + 1 + l <= maxCol -> return Hardspace+                        | otherwise                    -> return Hardline+      where+        hard = case soft of+            Softspace -> Hardspace+            Softline  -> Hardline+            _         -> soft++    nextWordLength :: [DocE Doc] -> Maybe Int+    nextWordLength []                 = Nothing+    nextWordLength (String x : xs)+        | L.null x                    = nextWordLength xs+        | otherwise                   = Just (wcstrwidth x)+    nextWordLength (Softspace : xs)   = nextWordLength xs+    nextWordLength (Hardspace : xs)   = nextWordLength xs+    nextWordLength (Softline : xs)    = nextWordLength xs+    nextWordLength (Hardline : _)     = Nothing+    nextWordLength (WrapAt {..} : xs) = nextWordLength (unDoc wrapDoc   ++ xs)+    nextWordLength (Ansi   {..} : xs) = nextWordLength (unDoc ansiDoc   ++ xs)+    nextWordLength (Indent {..} : xs) = nextWordLength (unDoc indentDoc ++ xs)+    nextWordLength (Control _ : _)    = Nothing+++--------------------------------------------------------------------------------+toString :: Doc -> String+toString = concat . map chunkToString . docToChunks+++--------------------------------------------------------------------------------+-- | Returns the rows and columns necessary to render this document+dimensions :: Doc -> (Int, Int)+dimensions doc =+    let ls = lines (toString doc) in+    (length ls, foldr max 0 (map wcstrwidth ls))+++--------------------------------------------------------------------------------+null :: Doc -> Bool+null doc = case unDoc doc of [] -> True; _ -> False+++--------------------------------------------------------------------------------+hPutDoc :: IO.Handle -> Doc -> IO ()+hPutDoc h = mapM_ (hPutChunk h) . docToChunks+++--------------------------------------------------------------------------------+putDoc :: Doc -> IO ()+putDoc = hPutDoc IO.stdout+++--------------------------------------------------------------------------------+mkDoc :: DocE Doc -> Doc+mkDoc e = Doc [e]+++--------------------------------------------------------------------------------+string :: String -> Doc+string = mkDoc . String  -- TODO (jaspervdj): Newline conversion?

@@ -0,0 +1,75 @@+--------------------------------------------------------------------------------+{-# LANGUAGE BangPatterns #-}+module Patat.PrettyPrint.Matrix+    ( Matrix+    , Cell (..)+    , emptyCell+    , docToMatrix+    , hPutMatrix+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad              (unless, when)+import           Data.Char.WCWidth.Extended (wcwidth)+import qualified Data.Vector                as V+import qualified Data.Vector.Mutable        as VM+import           Patat.PrettyPrint.Internal hiding (null)+import           Patat.Size                 (Size (..))+import qualified System.Console.ANSI        as Ansi+import qualified System.IO                  as IO+++--------------------------------------------------------------------------------+data Cell = Cell [Ansi.SGR] Char deriving (Eq, Show)+++--------------------------------------------------------------------------------+type Matrix = V.Vector Cell+++--------------------------------------------------------------------------------+emptyCell :: Cell+emptyCell = Cell [] ' '+++--------------------------------------------------------------------------------+docToMatrix :: Size -> Doc -> Matrix+docToMatrix size doc = V.create $ do+    matrix <- VM.replicate (sRows size * sCols size) emptyCell+    go matrix 0 0 $ docToChunks doc+    pure matrix+  where+    go _ _ _ []                                      = pure ()+    go _ y _ _  | y >= sRows size                    = pure ()+    go r y _ (NewlineChunk : cs)                     = go r (y + 1) 0 cs+    go r y x cs | x > sCols size                     = go r (y + 1) 0 cs+    go r y x (ControlChunk ClearScreenControl  : cs) = go r y x cs  -- ?+    go r _ x (ControlChunk (GoToLineControl y) : cs) = go r y x cs+    go r y x (StringChunk _      []      : cs)       = go r y x cs+    go r y x (StringChunk codes (z : zs) : cs)       = do+        VM.write r (y * sCols size + x) (Cell codes z)+        go r y (x + wcwidth z) (StringChunk codes zs : cs)+++--------------------------------------------------------------------------------+hPutMatrix :: IO.Handle -> Size -> Matrix -> IO ()+hPutMatrix h size matrix = go 0 0 0 []+  where+    go !y !x !empties prevCodes+        | x >= sCols size     = IO.hPutStrLn h "" >> go (y + 1) 0 0 prevCodes+        | y >= sRows size     = Ansi.hSetSGR h [Ansi.Reset]+        -- Try to not print empty things (e.g. fill the screen with spaces) as+        -- an optimization.  Instead, store the number of empties and print them+        -- when something actually follows.+        | cell == emptyCell   = do+            unless (null prevCodes) $ Ansi.hSetSGR h [Ansi.Reset]+            go y (x + 1) (empties + 1) []+        | otherwise           = do+            unless (empties == 0) $ IO.hPutStr h (replicate empties ' ')+            when (prevCodes /= codes) $+                Ansi.hSetSGR h (Ansi.Reset : reverse codes)+            IO.hPutStr h [c]+            go y (x + wcwidth c) 0 codes+      where+        cell@(Cell codes c) = matrix V.! (y * sCols size + x)

@@ -0,0 +1,23 @@+--------------------------------------------------------------------------------+module Patat.Size+    ( Size (..)+    , getTerminalSize+    ) where+++--------------------------------------------------------------------------------+import           Data.Maybe                   (fromMaybe)+import qualified System.Console.Terminal.Size as Terminal+++--------------------------------------------------------------------------------+data Size = Size {sRows :: Int, sCols :: Int} deriving (Show)+++--------------------------------------------------------------------------------+getTerminalSize :: IO Size+getTerminalSize = do+    mbWindow <- Terminal.size+    let rows = fromMaybe 24 $ Terminal.height <$> mbWindow+        cols = fromMaybe 72 $ Terminal.width  <$> mbWindow+    pure $ Size {sRows = rows, sCols = cols}

@@ -0,0 +1,42 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Patat.Transition+    ( Duration (..)+    , threadDelayDuration+    , TransitionGen+    , TransitionId+    , TransitionInstance (..)+    , parseTransitionSettings+    , newTransition+    , stepTransition+    ) where+++--------------------------------------------------------------------------------+import qualified Data.Aeson                  as A+import qualified Data.HashMap.Strict         as HMS+import           Data.Text                   (Text)+import qualified Data.Text                   as T+import           Patat.Presentation.Settings (TransitionSettings (..))+import           Patat.Transition.Internal+import qualified Patat.Transition.SlideLeft  as SlideLeft+++--------------------------------------------------------------------------------+transitions :: HMS.HashMap Text Transition+transitions = HMS.fromList+    [ ("slideLeft", Transition SlideLeft.slideLeft)+    ]+++--------------------------------------------------------------------------------+parseTransitionSettings+    :: TransitionSettings -> Either String TransitionGen+parseTransitionSettings ts = case HMS.lookup ty transitions of+    Nothing             -> Left $ "unknown transition type: " ++ show ty+    Just (Transition f) -> case A.fromJSON (A.Object $ tsParams ts) of+        A.Success conf -> Right $ f conf+        A.Error   err  -> Left $+            "could not parse " ++ T.unpack ty ++ " transition: " ++ err+  where+   ty = tsType ts

@@ -0,0 +1,81 @@+--------------------------------------------------------------------------------+{-# LANGUAGE GADTs #-}+module Patat.Transition.Internal+    ( Duration (..)+    , threadDelayDuration++    , Transition (..)+    , TransitionGen+    , TransitionId+    , TransitionInstance (..)+    , newTransition+    , stepTransition+    ) where+++--------------------------------------------------------------------------------+import           Control.Concurrent       (threadDelay)+import qualified Data.Aeson               as A+import           Data.List.NonEmpty       (NonEmpty ((:|)))+import           Data.Unique              (Unique, newUnique)+import qualified Patat.PrettyPrint        as PP+import           Patat.PrettyPrint.Matrix+import           Patat.Size               (Size (..))+import           System.Random            (StdGen, newStdGen)+++--------------------------------------------------------------------------------+newtype Duration = Duration Double  -- Duration in seconds+    deriving (Show)+++--------------------------------------------------------------------------------+threadDelayDuration :: Duration -> IO ()+threadDelayDuration (Duration seconds) =+    threadDelay . round $ seconds * 1000 * 1000+++--------------------------------------------------------------------------------+data Transition where+    Transition :: A.FromJSON conf => (conf -> TransitionGen) -> Transition+++--------------------------------------------------------------------------------+type TransitionGen =+    Size -> Matrix -> Matrix -> StdGen -> NonEmpty (Matrix, Duration)+++--------------------------------------------------------------------------------+newtype TransitionId = TransitionId Unique deriving (Eq)+++--------------------------------------------------------------------------------+data TransitionInstance = TransitionInstance+    { tiId     :: TransitionId+    , tiSize   :: Size+    , tiFrames :: NonEmpty (Matrix, Duration)+    }+++--------------------------------------------------------------------------------+newTransition+    :: TransitionGen -> Size -> PP.Doc -> PP.Doc -> IO TransitionInstance+newTransition tgen termSize frame0 frame1 = do+    unique <- newUnique+    rgen   <- newStdGen+    let frames = tgen size matrix0 matrix1 rgen+    pure $ TransitionInstance (TransitionId unique) size frames+  where+    -- The actual part we want to animate does not cover the last row, which is+    -- always empty.+    size    = termSize {sRows = sRows termSize - 1}+    matrix0 = docToMatrix size frame0+    matrix1 = docToMatrix size frame1+++--------------------------------------------------------------------------------+stepTransition :: TransitionId -> TransitionInstance -> Maybe TransitionInstance+stepTransition transId trans | transId /= tiId trans = Just trans+stepTransition _       trans                         = case tiFrames trans of+    _ :| []     -> Nothing+    _ :| f : fs -> Just trans {tiFrames = f :| fs}

@@ -0,0 +1,59 @@+--------------------------------------------------------------------------------+{-# LANGUAGE TemplateHaskell #-}+module Patat.Transition.SlideLeft+    ( slideLeft+    ) where+++--------------------------------------------------------------------------------+import qualified Data.Aeson.Extended       as A+import qualified Data.Aeson.TH.Extended    as A+import           Data.Foldable             (for_)+import           Data.List.NonEmpty        (NonEmpty ((:|)))+import           Data.Maybe                (fromMaybe)+import qualified Data.Vector               as V+import qualified Data.Vector.Mutable       as VM+import           Patat.PrettyPrint.Matrix+import           Patat.Size                (Size (..))+import           Patat.Transition.Internal+++--------------------------------------------------------------------------------+data Config = Config+    { cDuration  :: Maybe (A.FlexibleNum Double)+    , cFrameRate :: Maybe (A.FlexibleNum Int)+    }+++--------------------------------------------------------------------------------+slideLeft :: Config -> TransitionGen+slideLeft config (Size rows cols) initial final _rgen =+    fmap (\f -> (f, Duration delay)) $+    frame 0 :| map frame [1 .. frames - 1]+  where+    duration  = fromMaybe 1  $ A.unFlexibleNum <$> cDuration  config+    frameRate = fromMaybe 24 $ A.unFlexibleNum <$> cFrameRate config++    frames = round $ duration * fromIntegral frameRate :: Int+    delay  = duration / fromIntegral (frames + 1)++    frame :: Int -> Matrix+    frame idx = V.create $ do+        ini <- V.unsafeThaw initial+        fin <- V.unsafeThaw final+        mat <- VM.replicate (rows * cols) emptyCell+        for_ [0 .. rows - 1] $ \y -> do+            VM.copy+                (VM.slice (y * cols) (cols - offset) mat)+                (VM.slice (y * cols + offset) (cols - offset) ini)+            VM.copy+                (VM.slice (y * cols + cols - offset) offset mat)+                (VM.slice (y * cols) offset fin)+        pure mat+      where+        offset = max 0 . min cols . (round :: Double -> Int) $+            fromIntegral (idx + 1) / fromIntegral frames * fromIntegral cols+++--------------------------------------------------------------------------------+$(A.deriveFromJSON A.dropPrefixOptions ''Config)

@@ -1,5 +1,5 @@ Name:                patat-Version:             0.9.2.0+Version:             0.10.0.0 Synopsis:            Terminal-based presentations using Pandoc Description:         Terminal-based presentations using Pandoc. License:             GPL-2@@ -47,12 +47,14 @@     pandoc               >= 3.1  && < 3.2,     pandoc-types         >= 1.23 && < 1.24,     process              >= 1.6  && < 1.7,+    random               >= 1.1  && < 1.3,     skylighting          >= 0.10 && < 0.15,     terminal-size        >= 0.3  && < 0.4,     text                 >= 1.2  && < 2.1,     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.@@ -75,6 +77,7 @@     Patat.Images.W3m     Patat.Main     Patat.Presentation+    Patat.Presentation.Comments     Patat.Presentation.Display     Patat.Presentation.Display.CodeBlock     Patat.Presentation.Display.Internal@@ -84,11 +87,18 @@     Patat.Presentation.Interactive     Patat.Presentation.Internal     Patat.Presentation.Read-    Patat.Presentation.SpeakerNotes+    Patat.Presentation.Settings     Patat.PrettyPrint+    Patat.PrettyPrint.Internal+    Patat.PrettyPrint.Matrix+    Patat.Size     Patat.Theme+    Patat.Transition+    Patat.Transition.Internal+    Patat.Transition.SlideLeft    Other-modules:+    Control.Concurrent.Chan.Extended     Data.Aeson.Extended     Data.Aeson.TH.Extended     Data.Char.WCWidth.Extended