diff --git a/CHANGELOG.md b/CHANGELOG.md --- 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 --- 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 --- a/src/Main.hs +++ b/src/Main.hs @@ -132,7 +132,7 @@ 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 @@ -166,6 +166,12 @@ ErroredPresentation err -> loop pres (Just err) loop pres0 Nothing + + cleanup :: IO () + cleanup = do + Ansi.showCursor + Ansi.clearScreen + Ansi.setCursorPosition 0 0 -------------------------------------------------------------------------------- diff --git a/src/Patat/Presentation/Display.hs b/src/Patat/Presentation/Display.hs --- a/src/Patat/Presentation/Display.hs +++ b/src/Patat/Presentation/Display.hs @@ -34,9 +34,13 @@ -------------------------------------------------------------------------------- +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 @@ 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 @@ -------------------------------------------------------------------------------- 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 @@ 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 --- a/src/Patat/Presentation/Interactive.hs +++ b/src/Patat/Presentation/Interactive.hs @@ -95,18 +95,18 @@ 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 --- a/src/Patat/Presentation/Internal.hs +++ b/src/Patat/Presentation/Internal.hs @@ -10,6 +10,9 @@ , Index , getSlide + , numFragments + + , ActiveFragment (..) , getActiveFragment ) where @@ -46,13 +49,14 @@ , 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 @@ , 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 @@ , 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 @@ -------------------------------------------------------------------------------- -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 --- a/src/Patat/Presentation/Read.hs +++ b/src/Patat/Presentation/Read.hs @@ -126,8 +126,18 @@ -------------------------------------------------------------------------------- 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 @@ -------------------------------------------------------------------------------- +-- | 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) + splitAtRules blocks = case break (== Pandoc.HorizontalRule) blocks of + (xs, []) -> mkContentSlide xs + (xs, (_rule : ys)) -> mkContentSlide xs ++ splitAtRules ys - isH1 (Pandoc.Header i _ _) = i == 1 - isH1 _ = False + 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