summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasperVanDerJeugt <>2016-11-15 12:32:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-11-15 12:32:00 (GMT)
commit107b69cb8bfa2c63c3b64bbfa1fff295a7c8dd3b (patch)
tree5eb023bdccd568e78bb95e95999f7f935aea9b95
parent5ed76916df8d34c9e5f436555797b2c980b71d0e (diff)
version 0.4.0.00.4.0.0
-rw-r--r--CHANGELOG.md4
-rw-r--r--patat.cabal4
-rw-r--r--src/Main.hs16
-rw-r--r--src/Patat/AutoAdvance.hs52
-rw-r--r--src/Patat/Presentation/Display.hs27
-rw-r--r--src/Patat/Presentation/Fragment.hs129
-rw-r--r--src/Patat/Presentation/Interactive.hs42
-rw-r--r--src/Patat/Presentation/Internal.hs78
-rw-r--r--src/Patat/Presentation/Read.hs33
9 files changed, 325 insertions, 60 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 65bba9e..7b7bb9e 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,9 @@
# Changelog
+- 0.4.0.0 (2016-11-15)
+ * Add configurable auto advancing.
+ * Support fragmented slides.
+
- 0.3.3.0 (2016-10-31)
* Add a `--version` flag.
* Add support for `pandoc-1.18` which includes a new `LineBlock` element.
diff --git a/patat.cabal b/patat.cabal
index 35bcadc..917c002 100644
--- a/patat.cabal
+++ b/patat.cabal
@@ -1,5 +1,5 @@
Name: patat
-Version: 0.3.3.0
+Version: 0.4.0.0
Synopsis: Terminal-based presentations using Pandoc
Description: Terminal-based presentations using Pandoc
License: GPL-2
@@ -45,10 +45,12 @@ Executable patat
Data.Aeson.Extended
Data.Aeson.TH.Extended
Data.Data.Extended
+ Patat.AutoAdvance
Patat.Presentation
Patat.Presentation.Display
Patat.Presentation.Display.CodeBlock
Patat.Presentation.Display.Table
+ Patat.Presentation.Fragment
Patat.Presentation.Interactive
Patat.Presentation.Internal
Patat.Presentation.Read
diff --git a/src/Main.hs b/src/Main.hs
index fa434da..bfeca9c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -10,19 +10,21 @@ import Control.Applicative ((<$>), (<*>))
import Control.Concurrent (forkIO, threadDelay)
import qualified Control.Concurrent.Chan as Chan
import Control.Monad (forever, unless, when)
+import qualified Data.Aeson.Extended as A
import Data.Monoid (mempty, (<>))
import Data.Time (UTCTime)
import Data.Version (showVersion)
import qualified Options.Applicative as OA
+import Patat.AutoAdvance
import Patat.Presentation
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.PrettyPrint.ANSI.Leijen as PP
-import Prelude
--------------------------------------------------------------------------------
@@ -131,11 +133,17 @@ main = do
interactiveLoop :: Options -> Presentation -> IO ()
interactiveLoop options pres0 = do
IO.hSetBuffering IO.stdin IO.NoBuffering
- commandChan <- Chan.newChan
+ -- Spawn the initial channel that gives us commands based on user input.
+ commandChan0 <- Chan.newChan
+ _ <- forkIO $ forever $
+ readPresentationCommand >>= Chan.writeChan commandChan0
- _ <- forkIO $ forever $
- readPresentationCommand >>= Chan.writeChan commandChan
+ -- 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
+ -- 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
diff --git a/src/Patat/AutoAdvance.hs b/src/Patat/AutoAdvance.hs
new file mode 100644
index 0000000..236e0cb
--- /dev/null
+++ b/src/Patat/AutoAdvance.hs
@@ -0,0 +1,52 @@
+--------------------------------------------------------------------------------
+module Patat.AutoAdvance
+ ( autoAdvance
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Concurrent (forkIO, threadDelay)
+import qualified Control.Concurrent.Chan as Chan
+import Control.Monad (forever)
+import qualified Data.IORef as IORef
+import Data.Time (diffUTCTime, getCurrentTime)
+import Patat.Presentation (PresentationCommand (..))
+
+
+--------------------------------------------------------------------------------
+-- | 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
+ let delay = delaySeconds * 1000 -- We are working with ms in this function
+
+ newChan <- Chan.newChan
+ latestCommandAt <- IORef.newIORef =<< getCurrentTime
+
+ -- This is a thread that copies 'existingChan' to 'newChan', and writes
+ -- whenever the latest command was to 'latestCommandAt'.
+ _ <- forkIO $ forever $ do
+ cmd <- Chan.readChan existingChan
+ getCurrentTime >>= IORef.writeIORef latestCommandAt
+ Chan.writeChan newChan cmd
+
+ -- 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)
+
+ return newChan
diff --git a/src/Patat/Presentation/Display.hs b/src/Patat/Presentation/Display.hs
index 99762e3..1738e23 100644
--- a/src/Patat/Presentation/Display.hs
+++ b/src/Patat/Presentation/Display.hs
@@ -65,7 +65,8 @@ displayWithBorders Presentation {..} f = do
PP.putDoc $ withWrapSettings settings $ f theme
putStrLn ""
- let active = show (pActiveSlide + 1) ++ " / " ++ show (length pSlides)
+ let (sidx, _) = pActiveFragment
+ active = show (sidx + 1) ++ " / " ++ show (length pSlides)
activeWidth = length active
Ansi.setCursorPosition (rows - 2) 0
@@ -78,11 +79,8 @@ displayWithBorders Presentation {..} f = do
--------------------------------------------------------------------------------
displayPresentation :: Presentation -> IO ()
displayPresentation pres@Presentation {..} = displayWithBorders pres $ \theme ->
- let slide = case drop pActiveSlide pSlides of
- [] -> mempty
- (s : _) -> s in
-
- prettySlide theme slide
+ let fragment = fromMaybe mempty (getActiveFragment pres) in
+ prettyFragment theme fragment
--------------------------------------------------------------------------------
@@ -100,8 +98,11 @@ dumpPresentation :: Presentation -> IO ()
dumpPresentation pres =
let theme = fromMaybe Theme.defaultTheme (psTheme $ pSettings pres) in
PP.putDoc $ withWrapSettings (pSettings pres) $
- PP.vcat $ intersperse "----------" $
- map (prettySlide theme) $ pSlides pres
+ PP.vcat $ intersperse "----------" $ do
+ Slide fragments <- pSlides pres
+ return $ PP.vcat $ intersperse "~~~~~~~~~~" $ do
+ fragment <- fragments
+ return $ prettyFragment theme fragment
--------------------------------------------------------------------------------
@@ -112,10 +113,10 @@ withWrapSettings ps = case (psWrap ps, psColumns ps) of
--------------------------------------------------------------------------------
-prettySlide :: Theme -> Slide -> PP.Doc
-prettySlide theme slide@(Slide blocks) =
+prettyFragment :: Theme -> Fragment -> PP.Doc
+prettyFragment theme fragment@(Fragment blocks) =
prettyBlocks theme blocks <>
- case prettyReferences theme slide of
+ case prettyReferences theme fragment of
[] -> mempty
refs -> PP.hardline <> PP.vcat refs
@@ -284,9 +285,9 @@ prettyInlines theme = mconcat . map (prettyInline theme)
--------------------------------------------------------------------------------
-prettyReferences :: Theme -> Slide -> [PP.Doc]
+prettyReferences :: Theme -> Fragment -> [PP.Doc]
prettyReferences theme@Theme {..} =
- map prettyReference . getReferences . unSlide
+ map prettyReference . getReferences . unFragment
where
getReferences :: [Pandoc.Block] -> [Pandoc.Inline]
getReferences = filter isReferenceLink . grecQ
diff --git a/src/Patat/Presentation/Fragment.hs b/src/Patat/Presentation/Fragment.hs
new file mode 100644
index 0000000..d8bebae
--- /dev/null
+++ b/src/Patat/Presentation/Fragment.hs
@@ -0,0 +1,129 @@
+-- | For background info on the spec, see the "Incremental lists" section of the
+-- the pandoc manual.
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
+module Patat.Presentation.Fragment
+ ( FragmentSettings (..)
+ , fragmentBlocks
+ , fragmentBlock
+ ) where
+
+import Data.Foldable (Foldable)
+import Data.List (foldl', intersperse)
+import Data.Maybe (fromMaybe)
+import Data.Traversable (Traversable)
+import qualified Text.Pandoc as Pandoc
+import Prelude
+
+data FragmentSettings = FragmentSettings
+ { fsIncrementalLists :: !Bool
+ } deriving (Show)
+
+-- fragmentBlocks :: [Pandoc.Block] -> [[Pandoc.Block]]
+-- fragmentBlocks = NonEmpty.toList . joinFragmentedBlocks . map fragmentBlock
+fragmentBlocks :: FragmentSettings -> [Pandoc.Block] -> [[Pandoc.Block]]
+fragmentBlocks fs blocks0 =
+ case joinFragmentedBlocks (map (fragmentBlock fs) blocks0) of
+ Unfragmented bs -> [bs]
+ Fragmented xs bs -> map (fromMaybe []) xs ++ [fromMaybe [] bs]
+
+-- | This is all the ways we can "present" a block, after splitting in
+-- fragments.
+--
+-- In the simplest (and most common case) a block can only be presented in a
+-- single way ('Unfragmented').
+--
+-- Alternatively, we might want to show different (partial) versions of the
+-- block first before showing the final complete one. These partial or complete
+-- versions can be empty, hence the 'Maybe'.
+--
+-- For example, imagine that we display the following bullet list incrementally:
+--
+-- > [1, 2, 3]
+--
+-- Then we would get something like:
+--
+-- > Fragmented [Nothing, Just [1], Just [1, 2]] (Just [1, 2, 3])
+data Fragmented a
+ = Unfragmented a
+ | Fragmented [Maybe a] (Maybe a)
+ deriving (Functor, Foldable, Show, Traversable)
+
+fragmentBlock :: FragmentSettings -> Pandoc.Block -> Fragmented Pandoc.Block
+fragmentBlock _fs block@(Pandoc.Para inlines)
+ | inlines == threeDots = Fragmented [Nothing] Nothing
+ | otherwise = Unfragmented block
+ where
+ threeDots = intersperse Pandoc.Space $ replicate 3 (Pandoc.Str ".")
+
+fragmentBlock fs (Pandoc.BulletList bs0) =
+ fragmentList fs (fsIncrementalLists fs) Pandoc.BulletList bs0
+
+fragmentBlock fs (Pandoc.OrderedList attr bs0) =
+ fragmentList fs (fsIncrementalLists fs) (Pandoc.OrderedList attr) bs0
+
+fragmentBlock fs (Pandoc.BlockQuote [Pandoc.BulletList bs0]) =
+ fragmentList fs (not $ fsIncrementalLists fs) Pandoc.BulletList bs0
+
+fragmentBlock fs (Pandoc.BlockQuote [Pandoc.OrderedList attr bs0]) =
+ fragmentList fs (not $ fsIncrementalLists fs) (Pandoc.OrderedList attr) bs0
+
+fragmentBlock _ block@(Pandoc.BlockQuote _) = Unfragmented block
+
+fragmentBlock _ block@(Pandoc.Header _ _ _) = Unfragmented block
+fragmentBlock _ block@(Pandoc.Plain _) = Unfragmented block
+fragmentBlock _ block@(Pandoc.CodeBlock _ _) = Unfragmented block
+fragmentBlock _ block@(Pandoc.RawBlock _ _) = Unfragmented block
+fragmentBlock _ block@(Pandoc.DefinitionList _) = Unfragmented block
+fragmentBlock _ block@(Pandoc.Table _ _ _ _ _) = Unfragmented block
+fragmentBlock _ block@(Pandoc.Div _ _) = Unfragmented block
+fragmentBlock _ block@Pandoc.HorizontalRule = Unfragmented block
+fragmentBlock _ block@Pandoc.Null = Unfragmented block
+
+joinFragmentedBlocks :: [Fragmented block] -> Fragmented [block]
+joinFragmentedBlocks =
+ foldl' append (Unfragmented [])
+ where
+ append (Unfragmented xs) (Unfragmented y) =
+ Unfragmented (xs ++ [y])
+
+ append (Fragmented xs x) (Unfragmented y) =
+ Fragmented xs (appendMaybe x (Just y))
+
+ append (Unfragmented x) (Fragmented ys y) =
+ Fragmented
+ [appendMaybe (Just x) y' | y' <- ys]
+ (appendMaybe (Just x) y)
+
+ append (Fragmented xs x) (Fragmented ys y) =
+ Fragmented
+ (xs ++ [appendMaybe x y' | y' <- ys])
+ (appendMaybe x y)
+
+ appendMaybe :: Maybe [a] -> Maybe a -> Maybe [a]
+ appendMaybe Nothing Nothing = Nothing
+ appendMaybe Nothing (Just x) = Just [x]
+ appendMaybe (Just xs) Nothing = Just xs
+ appendMaybe (Just xs) (Just x) = Just (xs ++ [x])
+
+fragmentList
+ :: FragmentSettings -- ^ Global settings
+ -> Bool -- ^ Fragment THIS list?
+ -> ([[Pandoc.Block]] -> Pandoc.Block) -- ^ List constructor
+ -> [[Pandoc.Block]] -- ^ List items
+ -> Fragmented Pandoc.Block -- ^ Resulting list
+fragmentList fs fragmentThisList constructor blocks0 =
+ fmap constructor fragmented
+ where
+ -- The fragmented list per list item.
+ items :: [Fragmented [Pandoc.Block]]
+ items = map (joinFragmentedBlocks . map (fragmentBlock fs)) blocks0
+
+ fragmented :: Fragmented [[Pandoc.Block]]
+ fragmented = joinFragmentedBlocks $
+ map (if fragmentThisList then insertPause else id) items
+
+ insertPause :: Fragmented a -> Fragmented a
+ insertPause (Unfragmented x) = Fragmented [Nothing] (Just x)
+ insertPause (Fragmented xs x) = Fragmented (Nothing : xs) x
diff --git a/src/Patat/Presentation/Interactive.hs b/src/Patat/Presentation/Interactive.hs
index 226a715..d7d7d53 100644
--- a/src/Patat/Presentation/Interactive.hs
+++ b/src/Patat/Presentation/Interactive.hs
@@ -78,23 +78,43 @@ updatePresentation
updatePresentation cmd presentation = case cmd of
Exit -> return ExitedPresentation
- Forward -> return $ goToSlide (\x -> x + 1)
- Backward -> return $ goToSlide (\x -> x - 1)
- SkipForward -> return $ goToSlide (\x -> x + 10)
- SkipBackward -> return $ goToSlide (\x -> x - 10)
- First -> return $ goToSlide (\_ -> 0)
- Last -> return $ goToSlide (\_ -> numSlides presentation - 1)
+ Forward -> return $ goToSlide $ \(s, f) -> (s, f + 1)
+ Backward -> return $ goToSlide $ \(s, f) -> (s, f - 1)
+ SkipForward -> return $ goToSlide $ \(s, _) -> (s + 10, 0)
+ SkipBackward -> return $ goToSlide $ \(s, _) -> (s - 10, 0)
+ First -> return $ goToSlide $ \_ -> (0, 0)
+ Last -> return $ goToSlide $ \_ -> (numSlides presentation, 0)
Reload -> reloadPresentation
where
+ numSlides :: Presentation -> Int
numSlides pres = length (pSlides pres)
- clip idx pres = min (max 0 idx) (numSlides pres - 1)
- goToSlide f = UpdatedPresentation $
- presentation {pActiveSlide = clip (f $ pActiveSlide presentation) presentation}
+ clip :: Index -> Presentation -> Index
+ clip (slide, fragment) pres
+ | slide >= numSlides pres = (numSlides pres - 1, lastFragments - 1)
+ | slide < 0 = (0, 0)
+ | fragment >= numFragments slide =
+ if slide + 1 >= numSlides pres
+ then (slide, lastFragments - 1)
+ else (slide + 1, 0)
+ | fragment < 0 =
+ if slide - 1 >= 0
+ then (slide - 1, numFragments (slide - 1) - 1)
+ else (slide, 0)
+ | otherwise = (slide, fragment)
+ where
+ numFragments s = maybe 1 (length . unSlide) (getSlide s pres)
+ lastFragments = numFragments (numSlides pres - 1)
+
+ goToSlide :: (Index -> Index) -> UpdatedPresentation
+ goToSlide f = UpdatedPresentation $ presentation
+ { pActiveFragment = clip (f $ pActiveFragment presentation) presentation
+ }
reloadPresentation = do
errOrPres <- readPresentation (pFilePath presentation)
return $ case errOrPres of
Left err -> ErroredPresentation err
- Right pres -> UpdatedPresentation $
- pres {pActiveSlide = clip (pActiveSlide presentation) pres}
+ Right pres -> UpdatedPresentation $ pres
+ { pActiveFragment = clip (pActiveFragment presentation) pres
+ }
diff --git a/src/Patat/Presentation/Internal.hs b/src/Patat/Presentation/Internal.hs
index f11c46b..3554923 100644
--- a/src/Patat/Presentation/Internal.hs
+++ b/src/Patat/Presentation/Internal.hs
@@ -6,6 +6,11 @@ module Patat.Presentation.Internal
, PresentationSettings (..)
, defaultPresentationSettings
, Slide (..)
+ , Fragment (..)
+ , Index
+
+ , getSlide
+ , getActiveFragment
) where
@@ -13,7 +18,8 @@ module Patat.Presentation.Internal
import Control.Monad (mplus)
import qualified Data.Aeson.Extended as A
import qualified Data.Aeson.TH.Extended as A
-import Data.Monoid (Monoid (..))
+import Data.Maybe (listToMaybe)
+import Data.Monoid (Monoid (..), (<>))
import qualified Patat.Theme as Theme
import qualified Text.Pandoc as Pandoc
import Prelude
@@ -21,12 +27,12 @@ import Prelude
--------------------------------------------------------------------------------
data Presentation = Presentation
- { pFilePath :: !FilePath
- , pTitle :: ![Pandoc.Inline]
- , pAuthor :: ![Pandoc.Inline]
- , pSettings :: !PresentationSettings
- , pSlides :: [Slide]
- , pActiveSlide :: !Int
+ { pFilePath :: !FilePath
+ , pTitle :: ![Pandoc.Inline]
+ , pAuthor :: ![Pandoc.Inline]
+ , pSettings :: !PresentationSettings
+ , pSlides :: [Slide]
+ , pActiveFragment :: !Index
} deriving (Show)
@@ -34,38 +40,68 @@ data Presentation = Presentation
-- | 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))
- , psWrap :: !(Maybe Bool)
- , psTheme :: !(Maybe Theme.Theme)
+ { psRows :: !(Maybe (A.FlexibleNum Int))
+ , psColumns :: !(Maybe (A.FlexibleNum Int))
+ , psWrap :: !(Maybe Bool)
+ , psTheme :: !(Maybe Theme.Theme)
+ , psIncrementalLists :: !(Maybe Bool)
+ , psAutoAdvanceDelay :: !(Maybe (A.FlexibleNum Int))
} deriving (Show)
--------------------------------------------------------------------------------
instance Monoid PresentationSettings where
- mempty = PresentationSettings Nothing Nothing Nothing Nothing
+ mempty = PresentationSettings
+ Nothing Nothing Nothing Nothing Nothing Nothing
mappend l r = PresentationSettings
- { psRows = psRows l `mplus` psRows r
- , psColumns = psColumns l `mplus` psColumns r
- , psWrap = psWrap l `mplus` psWrap r
- , psTheme = psTheme l `mappend` psTheme r
+ { psRows = psRows l `mplus` psRows r
+ , psColumns = psColumns l `mplus` psColumns r
+ , psWrap = psWrap l `mplus` psWrap r
+ , psTheme = psTheme l <> psTheme r
+ , psIncrementalLists = psIncrementalLists l `mplus` psIncrementalLists r
+ , psAutoAdvanceDelay = psAutoAdvanceDelay l `mplus` psAutoAdvanceDelay r
}
--------------------------------------------------------------------------------
defaultPresentationSettings :: PresentationSettings
defaultPresentationSettings = PresentationSettings
- { psRows = Nothing
- , psColumns = Nothing
- , psWrap = Nothing
- , psTheme = Just Theme.defaultTheme
+ { psRows = Nothing
+ , psColumns = Nothing
+ , psWrap = Nothing
+ , psTheme = Just Theme.defaultTheme
+ , psIncrementalLists = Nothing
+ , psAutoAdvanceDelay = Nothing
}
--------------------------------------------------------------------------------
-newtype Slide = Slide {unSlide :: [Pandoc.Block]}
+newtype Slide = Slide {unSlide :: [Fragment]}
deriving (Monoid, Show)
--------------------------------------------------------------------------------
+newtype Fragment = Fragment {unFragment :: [Pandoc.Block]}
+ deriving (Monoid, Show)
+
+
+--------------------------------------------------------------------------------
+-- | Active slide, active fragment.
+type Index = (Int, Int)
+
+
+--------------------------------------------------------------------------------
+getSlide :: Int -> Presentation -> Maybe Slide
+getSlide sidx = listToMaybe . drop sidx . pSlides
+
+
+--------------------------------------------------------------------------------
+getActiveFragment :: Presentation -> Maybe Fragment
+getActiveFragment presentation = do
+ let (sidx, fidx) = pActiveFragment presentation
+ Slide fragments <- getSlide sidx presentation
+ listToMaybe $ drop fidx fragments
+
+
+--------------------------------------------------------------------------------
$(A.deriveJSON A.dropPrefixOptions ''PresentationSettings)
diff --git a/src/Patat/Presentation/Read.hs b/src/Patat/Presentation/Read.hs
index c962632..e345368 100644
--- a/src/Patat/Presentation/Read.hs
+++ b/src/Patat/Presentation/Read.hs
@@ -12,9 +12,11 @@ import Control.Monad.Except (ExceptT (..), runExceptT,
import Control.Monad.Trans (liftIO)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
+import Data.Maybe (fromMaybe)
import Data.Monoid (mempty, (<>))
import qualified Data.Set as Set
import qualified Data.Yaml as Yaml
+import Patat.Presentation.Fragment
import Patat.Presentation.Internal
import System.Directory (doesFileExist, getHomeDirectory)
import System.FilePath (takeExtension, (</>))
@@ -65,10 +67,10 @@ pandocToPresentation
:: FilePath -> PresentationSettings -> Pandoc.Pandoc
-> Either String Presentation
pandocToPresentation pFilePath pSettings pandoc@(Pandoc.Pandoc meta _) = do
- let !pTitle = Pandoc.docTitle meta
- !pSlides = pandocToSlides pandoc
- !pActiveSlide = 0
- !pAuthor = concat (Pandoc.docAuthors meta)
+ let !pTitle = Pandoc.docTitle meta
+ !pSlides = pandocToSlides pSettings pandoc
+ !pActiveFragment = (0, 0)
+ !pAuthor = concat (Pandoc.docAuthors meta)
return Presentation {..}
@@ -100,22 +102,33 @@ readHomeSettings = do
--------------------------------------------------------------------------------
+pandocToSlides :: PresentationSettings -> Pandoc.Pandoc -> [Slide]
+pandocToSlides settings pandoc =
+ let blockss = splitSlides pandoc in
+ map (Slide . map Fragment . (fragmentBlocks fragmentSettings)) blockss
+ where
+ fragmentSettings = FragmentSettings
+ { fsIncrementalLists = fromMaybe False (psIncrementalLists settings)
+ }
+
+
+--------------------------------------------------------------------------------
-- | Split a pandoc document into slides. If the document contains horizonal
-- rules, we use those as slide delimiters. If there are no horizontal rules,
-- we split using h1 headers.
-pandocToSlides :: Pandoc.Pandoc -> [Slide]
-pandocToSlides (Pandoc.Pandoc _meta blocks0)
+splitSlides :: Pandoc.Pandoc -> [[Pandoc.Block]]
+splitSlides (Pandoc.Pandoc _meta blocks0)
| any (== Pandoc.HorizontalRule) blocks0 = splitAtRules blocks0
| otherwise = splitAtH1s blocks0
where
splitAtRules blocks = case break (== Pandoc.HorizontalRule) blocks of
- (xs, []) -> [Slide xs]
- (xs, (_rule : ys)) -> Slide xs : splitAtRules ys
+ (xs, []) -> [xs]
+ (xs, (_rule : ys)) -> xs : splitAtRules ys
splitAtH1s [] = []
splitAtH1s (b : bs) = case break isH1 bs of
- (xs, []) -> [Slide (b : xs)]
- (xs, (y : ys)) -> Slide (b : xs) : splitAtH1s (y : ys)
+ (xs, []) -> [(b : xs)]
+ (xs, (y : ys)) -> (b : xs) : splitAtH1s (y : ys)
isH1 (Pandoc.Header i _ _) = i == 1
isH1 _ = False