summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasperVanDerJeugt <>2017-02-06 15:09:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-02-06 15:09:00 (GMT)
commitec2385c008604869ad9d7b34946cb4e8ae79edf6 (patch)
tree0177472b30e6ea2a385adb21cdeb00c3e0cce6c5
parent7de7649526405d6ab36ab10d0efe20b5944cbac5 (diff)
version 0.5.0.00.5.0.0
-rw-r--r--CHANGELOG.md14
-rw-r--r--patat.cabal2
-rw-r--r--src/Main.hs8
-rw-r--r--src/Patat/Presentation/Display.hs36
-rw-r--r--src/Patat/Presentation/Interactive.hs8
-rw-r--r--src/Patat/Presentation/Internal.hs34
-rw-r--r--src/Patat/Presentation/Read.hs69
7 files changed, 132 insertions, 39 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index ea6b6b1..583216b 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,19 @@
# Changelog
+- 0.5.0.0 (2017-02-06)
+ * Add a `slideLevel` option & autodetect it. This changes the way `patat`
+ splits slides. For more information, see the `README` or the `man` page.
+ If you just want to get the old behavior back, just add:
+
+ ---
+ patat:
+ slideLevel: 1
+ ...
+
+ To the top of your presentation.
+
+ * Clear the screen when finished with the presentation.
+
- 0.4.7.1 (2017-01-22)
* Bump `directory-1.3` dependency
* Bump `time-1.7` dependency
diff --git a/patat.cabal b/patat.cabal
index 4e23248..d0834d8 100644
--- a/patat.cabal
+++ b/patat.cabal
@@ -1,5 +1,5 @@
Name: patat
-Version: 0.4.7.1
+Version: 0.5.0.0
Synopsis: Terminal-based presentations using Pandoc
Description: Terminal-based presentations using Pandoc
License: GPL-2
diff --git a/src/Main.hs b/src/Main.hs
index 0fccfde..d555407 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -132,7 +132,7 @@ main = do
else interactiveLoop options pres
where
interactiveLoop :: Options -> Presentation -> IO ()
- interactiveLoop options pres0 = (`finally` Ansi.showCursor) $ do
+ interactiveLoop options pres0 = (`finally` cleanup) $ do
IO.hSetBuffering IO.stdin IO.NoBuffering
Ansi.hideCursor
@@ -167,6 +167,12 @@ main = do
loop pres0 Nothing
+ cleanup :: IO ()
+ cleanup = do
+ Ansi.showCursor
+ Ansi.clearScreen
+ Ansi.setCursorPosition 0 0
+
--------------------------------------------------------------------------------
watcher :: Chan.Chan PresentationCommand -> FilePath -> UTCTime -> IO a
diff --git a/src/Patat/Presentation/Display.hs b/src/Patat/Presentation/Display.hs
index cb562d7..e27de34 100644
--- a/src/Patat/Presentation/Display.hs
+++ b/src/Patat/Presentation/Display.hs
@@ -34,9 +34,13 @@ import qualified Text.Pandoc.Extended as Pandoc
--------------------------------------------------------------------------------
+data CanvasSize = CanvasSize {csRows :: Int, csCols :: Int} deriving (Show)
+
+
+--------------------------------------------------------------------------------
-- | Display something within the presentation borders that draw the title and
-- the active slide number and so on.
-displayWithBorders :: Presentation -> (Theme -> PP.Doc) -> IO ()
+displayWithBorders :: Presentation -> (CanvasSize -> Theme -> PP.Doc) -> IO ()
displayWithBorders Presentation {..} f = do
Ansi.clearScreen
Ansi.setCursorPosition 0 0
@@ -63,7 +67,8 @@ displayWithBorders Presentation {..} f = do
putStrLn ""
putStrLn ""
- PP.putDoc $ withWrapSettings settings $ f theme
+ let canvasSize = CanvasSize (rows - 2) columns
+ PP.putDoc $ withWrapSettings settings $ f canvasSize theme
putStrLn ""
let (sidx, _) = pActiveFragment
@@ -79,16 +84,25 @@ displayWithBorders Presentation {..} f = do
--------------------------------------------------------------------------------
displayPresentation :: Presentation -> IO ()
-displayPresentation pres@Presentation {..} = displayWithBorders pres $ \theme ->
- let fragment = fromMaybe mempty (getActiveFragment pres) in
- prettyFragment theme fragment
+displayPresentation pres@Presentation {..} = displayWithBorders pres $
+ \canvasSize theme -> case getActiveFragment pres of
+ Nothing -> mempty
+ Just (ActiveContent fragment) -> prettyFragment theme fragment
+ Just (ActiveTitle block) ->
+ let pblock = prettyBlock theme block
+ (prows, pcols) = PP.dimensions pblock
+ offsetRow = (csRows canvasSize `div` 2) - (prows `div` 2)
+ offsetCol = (csCols canvasSize `div` 2) - (pcols `div` 2)
+ spaces = mconcat (replicate offsetCol PP.space) in
+ mconcat (replicate (offsetRow - 1) PP.hardline) <$$>
+ PP.indent (PP.NotTrimmable spaces) (PP.NotTrimmable spaces) pblock
--------------------------------------------------------------------------------
-- | Displays an error in the place of the presentation. This is useful if we
-- want to display an error but keep the presentation running.
displayPresentationError :: Presentation -> String -> IO ()
-displayPresentationError pres err = displayWithBorders pres $ \Theme {..} ->
+displayPresentationError pres err = displayWithBorders pres $ \_ Theme {..} ->
themed themeStrong "Error occurred in the presentation:" <$$>
"" <$$>
(PP.string err)
@@ -100,10 +114,12 @@ dumpPresentation pres =
let theme = fromMaybe Theme.defaultTheme (psTheme $ pSettings pres) in
PP.putDoc $ withWrapSettings (pSettings pres) $
PP.vcat $ intersperse "----------" $ do
- Slide fragments <- pSlides pres
- return $ PP.vcat $ intersperse "~~~~~~~~~~" $ do
- fragment <- fragments
- return $ prettyFragment theme fragment
+ slide <- pSlides pres
+ return $ case slide of
+ TitleSlide block -> "~~~title" <$$> prettyBlock theme block
+ ContentSlide fragments -> PP.vcat $ intersperse "~~~frag" $ do
+ fragment <- fragments
+ return $ prettyFragment theme fragment
--------------------------------------------------------------------------------
diff --git a/src/Patat/Presentation/Interactive.hs b/src/Patat/Presentation/Interactive.hs
index 830f0ff..6c2dad1 100644
--- a/src/Patat/Presentation/Interactive.hs
+++ b/src/Patat/Presentation/Interactive.hs
@@ -95,18 +95,18 @@ updatePresentation cmd presentation = case cmd of
clip (slide, fragment) pres
| slide >= numSlides pres = (numSlides pres - 1, lastFragments - 1)
| slide < 0 = (0, 0)
- | fragment >= numFragments slide =
+ | 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)
+ 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)
+ numFragments' s = maybe 1 numFragments (getSlide s pres)
+ lastFragments = numFragments' (numSlides pres - 1)
goToSlide :: (Index -> Index) -> UpdatedPresentation
goToSlide f = UpdatedPresentation $ presentation
diff --git a/src/Patat/Presentation/Internal.hs b/src/Patat/Presentation/Internal.hs
index 3554923..c253f13 100644
--- a/src/Patat/Presentation/Internal.hs
+++ b/src/Patat/Presentation/Internal.hs
@@ -10,6 +10,9 @@ module Patat.Presentation.Internal
, Index
, getSlide
+ , numFragments
+
+ , ActiveFragment (..)
, getActiveFragment
) where
@@ -46,13 +49,14 @@ data PresentationSettings = PresentationSettings
, psTheme :: !(Maybe Theme.Theme)
, psIncrementalLists :: !(Maybe Bool)
, psAutoAdvanceDelay :: !(Maybe (A.FlexibleNum Int))
+ , psSlideLevel :: !(Maybe Int)
} deriving (Show)
--------------------------------------------------------------------------------
instance Monoid PresentationSettings where
mempty = PresentationSettings
- Nothing Nothing Nothing Nothing Nothing Nothing
+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing
mappend l r = PresentationSettings
{ psRows = psRows l `mplus` psRows r
, psColumns = psColumns l `mplus` psColumns r
@@ -60,6 +64,7 @@ instance Monoid PresentationSettings where
, psTheme = psTheme l <> psTheme r
, psIncrementalLists = psIncrementalLists l `mplus` psIncrementalLists r
, psAutoAdvanceDelay = psAutoAdvanceDelay l `mplus` psAutoAdvanceDelay r
+ , psSlideLevel = psSlideLevel l `mplus` psSlideLevel r
}
@@ -72,12 +77,15 @@ defaultPresentationSettings = PresentationSettings
, psTheme = Just Theme.defaultTheme
, psIncrementalLists = Nothing
, psAutoAdvanceDelay = Nothing
+ , psSlideLevel = Nothing
}
--------------------------------------------------------------------------------
-newtype Slide = Slide {unSlide :: [Fragment]}
- deriving (Monoid, Show)
+data Slide
+ = ContentSlide [Fragment]
+ | TitleSlide Pandoc.Block
+ deriving (Show)
--------------------------------------------------------------------------------
@@ -96,11 +104,25 @@ getSlide sidx = listToMaybe . drop sidx . pSlides
--------------------------------------------------------------------------------
-getActiveFragment :: Presentation -> Maybe Fragment
+numFragments :: Slide -> Int
+numFragments (ContentSlide fragments) = length fragments
+numFragments (TitleSlide _) = 1
+
+
+--------------------------------------------------------------------------------
+data ActiveFragment = ActiveContent Fragment | ActiveTitle Pandoc.Block
+ deriving (Show)
+
+
+--------------------------------------------------------------------------------
+getActiveFragment :: Presentation -> Maybe ActiveFragment
getActiveFragment presentation = do
let (sidx, fidx) = pActiveFragment presentation
- Slide fragments <- getSlide sidx presentation
- listToMaybe $ drop fidx fragments
+ slide <- getSlide sidx presentation
+ case slide of
+ TitleSlide block -> return (ActiveTitle block)
+ ContentSlide fragments ->
+ fmap ActiveContent . listToMaybe $ drop fidx fragments
--------------------------------------------------------------------------------
diff --git a/src/Patat/Presentation/Read.hs b/src/Patat/Presentation/Read.hs
index 19d357d..92bce07 100644
--- a/src/Patat/Presentation/Read.hs
+++ b/src/Patat/Presentation/Read.hs
@@ -126,8 +126,18 @@ readHomeSettings = do
--------------------------------------------------------------------------------
pandocToSlides :: PresentationSettings -> Pandoc.Pandoc -> [Slide]
pandocToSlides settings pandoc =
- let blockss = splitSlides pandoc in
- map (Slide . map Fragment . (fragmentBlocks fragmentSettings)) blockss
+ let slideLevel = fromMaybe (detectSlideLevel pandoc) (psSlideLevel settings)
+ unfragmented = splitSlides slideLevel pandoc
+ fragmented =
+ [ case slide of
+ TitleSlide _ -> slide
+ ContentSlide fragments0 ->
+ let blocks = concatMap unFragment fragments0
+ blockss = fragmentBlocks fragmentSettings blocks in
+ ContentSlide (map Fragment blockss)
+ | slide <- unfragmented
+ ] in
+ fragmented
where
fragmentSettings = FragmentSettings
{ fsIncrementalLists = fromMaybe False (psIncrementalLists settings)
@@ -135,22 +145,47 @@ pandocToSlides settings pandoc =
--------------------------------------------------------------------------------
+-- | Find level of header that starts slides. This is defined as the least
+-- header that occurs before a non-header in the blocks.
+detectSlideLevel :: Pandoc.Pandoc -> Int
+detectSlideLevel (Pandoc.Pandoc _meta blocks0) =
+ go 6 blocks0
+ where
+ go level (Pandoc.Header n _ _ : x : xs)
+ | n < level && nonHeader x = go n xs
+ | otherwise = go level (x:xs)
+ go level (_ : xs) = go level xs
+ go level [] = level
+
+ nonHeader (Pandoc.Header _ _ _) = False
+ nonHeader _ = True
+
+
+--------------------------------------------------------------------------------
-- | 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.
-splitSlides :: Pandoc.Pandoc -> [[Pandoc.Block]]
-splitSlides (Pandoc.Pandoc _meta blocks0)
- | any (== Pandoc.HorizontalRule) blocks0 = splitAtRules blocks0
- | otherwise = splitAtH1s blocks0
+-- we split using headers, determined by the slide level (see
+-- 'detectSlideLevel').
+splitSlides :: Int -> Pandoc.Pandoc -> [Slide]
+splitSlides slideLevel (Pandoc.Pandoc _meta blocks0)
+ | any (== Pandoc.HorizontalRule) blocks0 = splitAtRules blocks0
+ | otherwise = splitAtHeaders [] blocks0
where
- splitAtRules blocks = case break (== Pandoc.HorizontalRule) blocks of
- (xs, []) -> [xs]
- (xs, (_rule : ys)) -> xs : splitAtRules ys
+ mkContentSlide :: [Pandoc.Block] -> [Slide]
+ mkContentSlide [] = [] -- Never create empty slides
+ mkContentSlide bs = [ContentSlide [Fragment bs]]
- splitAtH1s [] = []
- splitAtH1s (b : bs) = case break isH1 bs of
- (xs, []) -> [(b : xs)]
- (xs, (y : ys)) -> (b : xs) : splitAtH1s (y : ys)
-
- isH1 (Pandoc.Header i _ _) = i == 1
- isH1 _ = False
+ splitAtRules blocks = case break (== Pandoc.HorizontalRule) blocks of
+ (xs, []) -> mkContentSlide xs
+ (xs, (_rule : ys)) -> mkContentSlide xs ++ splitAtRules ys
+
+ splitAtHeaders acc [] =
+ mkContentSlide (reverse acc)
+ splitAtHeaders acc (b@(Pandoc.Header i _ _) : bs)
+ | i > slideLevel = splitAtHeaders (b : acc) bs
+ | i == slideLevel =
+ mkContentSlide (reverse acc) ++ splitAtHeaders [b] bs
+ | otherwise =
+ mkContentSlide (reverse acc) ++ [TitleSlide b] ++ splitAtHeaders [] bs
+ splitAtHeaders acc (b : bs) =
+ splitAtHeaders (b : acc) bs