From feb62fb5c6292583f2a8e5ee1e60b3cba71b5a5d Mon Sep 17 00:00:00 2001 From: Benjamin Schmidt Date: Thu, 1 Oct 2020 14:49:43 -0400 Subject: [PATCH] 2.7.3 version --- src/lectureToSlidedeck.hs | 103 +++++++++++++++----------------------- 1 file changed, 41 insertions(+), 62 deletions(-) diff --git a/src/lectureToSlidedeck.hs b/src/lectureToSlidedeck.hs index f5876ff..5c055fd 100644 --- a/src/lectureToSlidedeck.hs +++ b/src/lectureToSlidedeck.hs @@ -13,43 +13,63 @@ import Network.HTTP.Base (urlEncode) --Functions to first build up a new document consisting of --all the header blocks or quote blocks. To be combined into a new --doc. + extractSlides :: Block -> [Block] ---Level one headers get their own slide, followed by a horizontal rule. ---All slides, in general, are followed by a Horizontal rule to ensure blocks don't run into each other. +--Level one headers get their own slide. extractSlides (Header n m xs) - | n==1 = [(Header 1 m xs), HorizontalRule] + | n==1 = [(Header 1 m xs)] | otherwise = [] -- Divs of class 'slide' are expanded into their contents, -- with a slidebreak delimiter at the end. extractSlides (Div (id, classes, meta) contents) - | "slide" `elem` classes = contents ++ [HorizontalRule] + | "slide" `elem` classes = add_header (Div (id, classes, meta) contents) | otherwise = [] where content = Div (id, classes, meta) contents - -- standalone images (and iframes) are automatically turned into slides. -extractSlides (Para [Image attr text (target_1, target_2)]) = - [fiximages (Para [Image attr text (target_1, target_2)]), HorizontalRule] +extractSlides (Para [Image attr text (target_1, target_2)]) = + fiximages (Para [Image attr text (target_1, target_2)]) --All other text is skipped extractSlides x = [] +-- Drop an empty level two header as a fake slide start. + +add_header :: Block -> [Block] +add_header (Div attr contents) = + [Header 2 attr [], Div nullAttr contents] +add_header x = [Header 2 nullAttr [], x] + + +fiximages :: Block -> [Block] +-- Images and Iframes that occupy a whole paragraph on their own are reformatted. +-- an initial ">" before the link target denotes presenting it as an iframe, not an image. +-- More recently, pandoc seems to encodeurl '>' as '%3E'; keeping the old pattern just in case. +fiximages (Para [Image attr text ('>':target,_)]) = + add_header (Div attr [Para text, Plain [(makeIframe target)]]) + +fiximages (Para [Image attr text ('%':'3':'E':target, xs)]) = + fiximages (Para [Image attr text ('>':target, xs)]) + +fiximages (Para [Image attr text (target_1, target_2)]) = do +-- let myimage =[Image nullAttr [] (target_1, target_2)] +-- let newlink = fancyLink $ Link nullAttr myimage (target_1, target_2) +-- let title = fancyLink $ Link nullAttr text (target_1, target_2) +-- Div nullAttr [Para [title], Para [newlink]] +-- let divAttr = ([], [], [("data-background-image",target_1),("data-background-size","contain")]) + let image_header = Header 2 ([], [], [("data-background-image",target_1),("data-background-size","contain")]) [] + let imageText = Plain [Span (boxenate attr) text] + [image_header, imageText] + +-- Anything else is just itself. +fiximages x = [x] + --- This is just for my personal use. Shouldn't affect anyone else. -addBookwormLinks :: Block -> Block -addBookwormLinks (CodeBlock (codeblock,["bookworm"],keyvals) code) = do - let block = (CodeBlock (codeblock,["bookworm"],keyvals) code) - let target = "http://benschmidt.org/BookwormD3/#" ++ (urlEncode code) - let target = "http://benschmidt.org/D3/#" ++ (urlEncode code) - let link = Para [Link nullAttr [Str "View"] (target,"")] - Div nullAttr [block,link] ---addBookwormLinks (RawBlock _ _) = Null -addBookwormLinks x = x fancyLink :: Inline -> Inline -- For the time being, reveal.js will launch links *inside* the window. This is nice, so I do it for all links. @@ -61,7 +81,6 @@ fancyLink x = x makeIframe :: String -> Inline - -- data-src instead of 'src' for images causes lazy-loading. resrc :: (String, String) -> (String, String) resrc ("src", x) = ("data-src", x) @@ -77,56 +96,16 @@ makeIframe target = do let iframe = "" RawInline (Format "html") iframe -fiximages :: Block -> Block --- Images and Iframes that occupy a whole paragraph on their own are reformatted. --- an initial ">" before the link target denotes presenting it as an iframe, not an image. --- More recently, pandoc seems to encodeurl '>' as '%3E'; keeping the old pattern just in case. -fiximages (Para [Image attr text ('>':target,_)]) = - Div attr [Para text, Plain [(makeIframe target)]] - -fiximages (Para [Image attr text ('%':'3':'E':target,_)]) = - Div attr [Para text, Plain [(makeIframe target)]] - -fiximages (Para [Image attr [] (target_1, target_2)]) = - Header 2 ([],[],[("data-background-image",target_1),("data-background-size","contain")]) [] - -- Don't change until the fullscreen works again. --- Para [Image attr [] (target_1, target_2)] - --- Putting a period as the text does the same thing--back compatibility. -fiximages (Para [Image attr [(Str ".")] (target_1, target_2)]) = do - Header 2 ([],[],[("data-background-image",target_1),("data-background-size","contain")]) [] - -fiximages (Para [Image attr text (target_1, target_2)]) = do - let myimage =[Image nullAttr [] (target_1, target_2)] - let newlink = fancyLink $ Link nullAttr myimage (target_1, target_2) - let title = fancyLink $ Link nullAttr text (target_1, target_2) --- Div nullAttr [Para [title], Para [newlink]] - Header 2 ([], [], [("data-background-image",target_1),("data-background-size","contain")]) [Span attr text] - --- Anything else is just itself. -fiximages x = x +boxenate :: Attr -> Attr +boxenate (id, classes, keyvals) = + (id, ("attribution":classes), keyvals) slideReturn :: Pandoc -> Pandoc --- Should probably be a foldl, but I forget how. - -removeUnneededBars :: [Block] -> [Block] - -removeUnneededBars (HorizontalRule:Header n m x:xs) = - (Header n m x):removeUnneededBars(xs) - -removeUnneededBars (x:y:xs) = - x:removeUnneededBars(y:xs) - -removeUnneededBars [x] = - [x] - -removeUnneededBars [] = - [] slideReturn (Pandoc meta blocks) = do let slides = query extractSlides blocks - let newData = removeUnneededBars $ walk fiximages $ walk fancyLink $ slides + let newData = walk fancyLink $ slides -- let newData = walk fiximages $ walk fancyLink $ slides Pandoc meta newData