version 0.5.0.00.5.0.0

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