@@ -13,43 +13,63 @@ import Network.HTTP.Base (urlEncode)
1313-- Functions to first build up a new document consisting of
1414-- all the header blocks or quote blocks. To be combined into a new
1515-- doc.
16+
1617extractSlides :: Block -> [Block ]
1718
18- -- Level one headers get their own slide, followed by a horizontal rule.
19- -- All slides, in general, are followed by a Horizontal rule to ensure blocks don't run into each other.
19+ -- Level one headers get their own slide.
2020
2121extractSlides (Header n m xs)
22- | n== 1 = [(Header 1 m xs), HorizontalRule ]
22+ | n== 1 = [(Header 1 m xs)]
2323 | otherwise = []
2424
2525-- Divs of class 'slide' are expanded into their contents,
2626-- with a slidebreak delimiter at the end.
2727
2828extractSlides (Div (id , classes, meta) contents)
29- | " slide" `elem` classes = contents ++ [ HorizontalRule ]
29+ | " slide" `elem` classes = add_header ( Div ( id , classes, meta) contents)
3030 | otherwise = []
3131 where content = Div (id , classes, meta) contents
3232
33-
3433-- standalone images (and iframes) are automatically turned into slides.
3534
36- extractSlides (Para [Image attr text (target_1, target_2)]) =
37- [ fiximages (Para [Image attr text (target_1, target_2)]), HorizontalRule ]
35+ extractSlides (Para [Image attr text (target_1, target_2)]) =
36+ fiximages (Para [Image attr text (target_1, target_2)])
3837
3938-- All other text is skipped
4039extractSlides x = []
4140
41+ -- Drop an empty level two header as a fake slide start.
42+
43+ add_header :: Block -> [Block ]
44+ add_header (Div attr contents) =
45+ [Header 2 attr [] , Div nullAttr contents]
46+ add_header x = [Header 2 nullAttr [] , x]
47+
48+
49+ fiximages :: Block -> [Block ]
50+ -- Images and Iframes that occupy a whole paragraph on their own are reformatted.
51+ -- an initial ">" before the link target denotes presenting it as an iframe, not an image.
52+ -- More recently, pandoc seems to encodeurl '>' as '%3E'; keeping the old pattern just in case.
53+ fiximages (Para [Image attr text (' >' : target,_)]) =
54+ add_header (Div attr [Para text, Plain [(makeIframe target)]])
55+
56+ fiximages (Para [Image attr text (' %' : ' 3' : ' E' : target, xs)]) =
57+ fiximages (Para [Image attr text (' >' : target, xs)])
58+
59+ fiximages (Para [Image attr text (target_1, target_2)]) = do
60+ -- let myimage =[Image nullAttr [] (target_1, target_2)]
61+ -- let newlink = fancyLink $ Link nullAttr myimage (target_1, target_2)
62+ -- let title = fancyLink $ Link nullAttr text (target_1, target_2)
63+ -- Div nullAttr [Para [title], Para [newlink]]
64+ -- let divAttr = ([], [], [("data-background-image",target_1),("data-background-size","contain")])
65+ let image_header = Header 2 ([] , [] , [(" data-background-image" ,target_1),(" data-background-size" ," contain" )]) []
66+ let imageText = Plain [Span (boxenate attr) text]
67+ [image_header, imageText]
68+
69+ -- Anything else is just itself.
70+ fiximages x = [x]
71+
4272
43- -- This is just for my personal use. Shouldn't affect anyone else.
44- addBookwormLinks :: Block -> Block
45- addBookwormLinks (CodeBlock (codeblock,[" bookworm" ],keyvals) code) = do
46- let block = (CodeBlock (codeblock,[" bookworm" ],keyvals) code)
47- let target = " http://benschmidt.org/BookwormD3/#" ++ (urlEncode code)
48- let target = " http://benschmidt.org/D3/#" ++ (urlEncode code)
49- let link = Para [Link nullAttr [Str " View" ] (target," " )]
50- Div nullAttr [block,link]
51- -- addBookwormLinks (RawBlock _ _) = Null
52- addBookwormLinks x = x
5373
5474fancyLink :: Inline -> Inline
5575-- 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
6181
6282makeIframe :: String -> Inline
6383
64-
6584-- data-src instead of 'src' for images causes lazy-loading.
6685resrc :: (String , String ) -> (String , String )
6786resrc (" src" , x) = (" data-src" , x)
@@ -77,56 +96,16 @@ makeIframe target = do
7796 let iframe = " <iframe allowfullscreen width=95% height=600px data-src=\" " ++ target ++ " \" data-autoplay></iframe>"
7897 RawInline (Format " html" ) iframe
7998
80- fiximages :: Block -> Block
81- -- Images and Iframes that occupy a whole paragraph on their own are reformatted.
82- -- an initial ">" before the link target denotes presenting it as an iframe, not an image.
83- -- More recently, pandoc seems to encodeurl '>' as '%3E'; keeping the old pattern just in case.
84- fiximages (Para [Image attr text (' >' : target,_)]) =
85- Div attr [Para text, Plain [(makeIframe target)]]
86-
87- fiximages (Para [Image attr text (' %' : ' 3' : ' E' : target,_)]) =
88- Div attr [Para text, Plain [(makeIframe target)]]
89-
90- fiximages (Para [Image attr [] (target_1, target_2)]) =
91- Header 2 ([] ,[] ,[(" data-background-image" ,target_1),(" data-background-size" ," contain" )]) []
92- -- Don't change until the fullscreen works again.
93- -- Para [Image attr [] (target_1, target_2)]
94-
95- -- Putting a period as the text does the same thing--back compatibility.
96- fiximages (Para [Image attr [(Str " ." )] (target_1, target_2)]) = do
97- Header 2 ([] ,[] ,[(" data-background-image" ,target_1),(" data-background-size" ," contain" )]) []
98-
99- fiximages (Para [Image attr text (target_1, target_2)]) = do
100- let myimage = [Image nullAttr [] (target_1, target_2)]
101- let newlink = fancyLink $ Link nullAttr myimage (target_1, target_2)
102- let title = fancyLink $ Link nullAttr text (target_1, target_2)
103- -- Div nullAttr [Para [title], Para [newlink]]
104- Header 2 ([] , [] , [(" data-background-image" ,target_1),(" data-background-size" ," contain" )]) [Span attr text]
105-
106- -- Anything else is just itself.
107- fiximages x = x
99+ boxenate :: Attr -> Attr
100+ boxenate (id , classes, keyvals) =
101+ (id , (" attribution" : classes), keyvals)
108102
109103slideReturn :: Pandoc -> Pandoc
110104
111- -- Should probably be a foldl, but I forget how.
112-
113- removeUnneededBars :: [Block ] -> [Block ]
114-
115- removeUnneededBars (HorizontalRule : Header n m x: xs) =
116- (Header n m x): removeUnneededBars(xs)
117-
118- removeUnneededBars (x: y: xs) =
119- x: removeUnneededBars(y: xs)
120-
121- removeUnneededBars [x] =
122- [x]
123-
124- removeUnneededBars [] =
125- []
126105
127106slideReturn (Pandoc meta blocks) = do
128107 let slides = query extractSlides blocks
129- let newData = removeUnneededBars $ walk fiximages $ walk fancyLink $ slides
108+ let newData = walk fancyLink $ slides
130109-- let newData = walk fiximages $ walk fancyLink $ slides
131110 Pandoc meta newData
132111
0 commit comments