patat 0.4.7.1 → 0.5.0.0
raw patch · 7 files changed
+131/−38 lines, 7 files
Files
- CHANGELOG.md +14/−0
- patat.cabal +1/−1
- src/Main.hs +7/−1
- src/Patat/Presentation/Display.hs +26/−10
- src/Patat/Presentation/Interactive.hs +4/−4
- src/Patat/Presentation/Internal.hs +28/−6
- src/Patat/Presentation/Read.hs +51/−16
CHANGELOG.md view
@@ -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
patat.cabal view
@@ -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
src/Main.hs view
@@ -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 --------------------------------------------------------------------------------
src/Patat/Presentation/Display.hs view
@@ -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 --------------------------------------------------------------------------------
src/Patat/Presentation/Interactive.hs view
@@ -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
src/Patat/Presentation/Internal.hs view
@@ -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 --------------------------------------------------------------------------------
src/Patat/Presentation/Read.hs view
@@ -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