diff --git a/TODO.md b/TODO.md new file mode 100644 index 0000000..c701049 --- /dev/null +++ b/TODO.md @@ -0,0 +1,6 @@ + +- fragments in figure-Umgebung +- svg per default als img + - done +- reveal hat speziell html-attribute => herausfinden und in direct-controls rein + - in utils ~> müssen noch überall angepasst werden. diff --git a/app/Clean.hs b/app/Clean.hs index fcb5f71..1801343 100644 --- a/app/Clean.hs +++ b/app/Clean.hs @@ -2,9 +2,6 @@ {-# LANGUAGE ScopedTypeVariables #-} import Text.Pandoc.JSON -import Control.Exception -import Data.Monoid ((<>)) -import Data.List (partition, isInfixOf) main :: IO () main = toJSONFilter clean diff --git a/app/Cols.hs b/app/Cols.hs index d44db55..b9628b9 100644 --- a/app/Cols.hs +++ b/app/Cols.hs @@ -1,82 +1,9 @@ #!/usr/bin/env runhaskell -{-# LANGUAGE ScopedTypeVariables #-} import Text.Pandoc.JSON -import Text.Pandoc.Definition import Text.Pandoc.Generic (topDown) -import Control.Exception -import Data.Monoid ((<>)) -import Data.List (partition, elem) -import System.FilePath -import Debug.Trace (trace) -import Text.Read (readMaybe) -import Data.Maybe (fromMaybe) + +import Text.Pandoc.Util.Filter.Cols main :: IO () main = toJSONFilter (topDown cols :: Pandoc -> Pandoc) - - --- | This filter makes multi-column-layouts out of lvl-x-headings --- --- Syntax is --- --- ## a b --- --- yielding a 2-column-layout with aspects a:b i.e. 1:1 for 50/50-layout --- or 8:2 for 80/20 layout --- --- currently works for 2 and 3-columns, but extension is straight-forward. --- --- If you need multiple Block-Elements inside one column, just wrap them --- with a
: --- --- ## 2 5 --- ---
--- multiple things --- ``` --- foo --- ``` --- ![image](...) ---
--- --- second column here with only 1 element. --- -cols :: [Block] -> [Block] -cols (h@(Header 2 attr [Str wa,Space,Str wb]):a:b:rest) = - outerDiv:rest - where - wa' = fromMaybe 1 (readMaybe wa) :: Int - wb' = fromMaybe 1 (readMaybe wb) :: Int - total = wa' + wb' - pa = (100*wa') `div` total - pb = (100*wb') `div` total - outerDiv = Div attr [ makeDiv pa a - , makeDiv pb b - , clearDiv - ] -cols (h@(Header 3 attr [Str wa,Space,Str wb,Space,Str wc]):a:b:c:rest) = - outerDiv:rest - where - wa' = fromMaybe 1 (readMaybe wa) :: Int - wb' = fromMaybe 1 (readMaybe wb) :: Int - wc' = fromMaybe 1 (readMaybe wc) :: Int - total = wa' + wb' + wc' - pa = (100*wa') `div` total - pb = (100*wb') `div` total - pc = (100*wc') `div` total - outerDiv = Div attr [ makeDiv pa a - , makeDiv pb b - , makeDiv pc c - , clearDiv - ] -cols x = x - -makeDiv :: Int -> Block -> Block -makeDiv width content = Div ("", [], [("style","width:" <> show width <> "%;float:left")]) [content] - -clearDiv :: Block -clearDiv = Div ("", [], [("style", "clear: both")]) [Plain [toHtml " "]] - -toHtml :: String -> Inline -toHtml = RawInline (Format "html") diff --git a/app/Media.hs b/app/Media.hs index 242ac21..5f1277a 100644 --- a/app/Media.hs +++ b/app/Media.hs @@ -1,184 +1,6 @@ #!/usr/bin/env runhaskell -{-# LANGUAGE ScopedTypeVariables #-} - +import Text.Pandoc.Util.Filter.Media import Text.Pandoc.JSON -import Control.Exception -import Data.Monoid ((<>)) -import Data.List (partition, elem) -import Data.Char (toLower) -import System.FilePath main :: IO () main = toJSONFilter media - --- | File-extensions that should be treated as audio -audioExt :: [String] -audioExt = ["mp3","aac"] - --- | File-extensions that should be treated as video -videoExt :: [String] -videoExt = [ "avi" - , "mp4" - , "mov" - ] - --- | File-extensions that should be treated as image -imgExt :: [String] -imgExt = - [ "jpg" - , "jpeg" - , "png" - , "gif" - , "tif" - , "tiff" - , "bmp" - ] - --- | File-extensions that should be treated as demo and will be included --- in an iframe -demoExt :: [String] -demoExt = ["html", "htm"] - --- | main media-plugin. --- --- Will convert the following syntax --- --- --- - `![](foo.aac){#audio}` --- - `![](foo.mp4){#video}` --- - `![](foo.png){#img}` --- - `![](foo.svg){#svg}` --- - `![](foo.html){#demo}` --- --- HTML-id's maybe ommitted if the file-extension is in whitelist. --- --- If a type is detected by extension a custom id (not matching the extension) --- will be preserved. --- -media :: Inline -> IO [Inline] ---audio -media (Image (id',att,att') [] (filename,_)) - | id' == "audio" || (checkExtension filename audioExt) - = return $ [toHtml $ ""] - where - (direct, css) = classToPlain att -media (Image (id',att,att') alt (filename,_)) - | id' == "audio" || (checkExtension filename audioExt) - = return $ [toHtml $ "
"] - ++ [toHtml $ "
"] - ++ alt - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att ---videos -media (Image (id', att, att') [] (filename,_)) - | id' == "video" || (checkExtension filename videoExt) - = return $ [toHtml $ ""] - where - (direct, css) = classToPlain att -media (Image (id', att, att') alt (filename,_)) - | id' == "video" || (checkExtension filename videoExt) - = return $ [toHtml $ "
"] - ++ [toHtml $ ""] - ++ [toHtml $ "
"] - ++ alt - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att ---images -media (Image (id', att, att') [] (filename,_)) - | id' == "img" || (checkExtension filename imgExt) - = return $ [toHtml $ "
"] - ++ [toHtml $ " unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> ">"] - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att -media (Image (id', att, att') alt (filename,_)) - | id' == "img" || (checkExtension filename imgExt) - = return $ [toHtml $ "
"] - ++ [toHtml $ " unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> ">"] - ++ [toHtml $ "
"] - ++ alt - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att ---load svg and dump it in -media (Image (id', att, att') [] (filename,_)) - | id' == "svg" || (checkExtension filename ["svg"]) - = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "
" <> show fileerror]) $ - do - svg <- readFile filename - return $ [toHtml $ "
unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"] -- use attributes on figure, as svg gets dumped in.. - ++ [toHtml $ svg] - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att -media (Image (id', att, att') alt (filename,_)) - | id' == "svg" || (checkExtension filename ["svg"]) - = handle (\(fileerror :: IOException) -> return $ [toHtml $ "Could not read file: " <> filename <> "
" <> show filename]) $ - do - svg <- readFile filename - return $ [toHtml $ "
unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"] -- use attributes on figure, as svg gets dumped in.. - ++ [toHtml $ svg] - ++ [toHtml $ "
"] - ++ alt - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att ---html-demos etc. as IFrames -media (Image (id', att, att') [] (filename,_)) - | id' == "demo" || (checkExtension filename demoExt) - = return $ [toHtml $ ""] - where - (direct, css) = classToPlain att -media (Image (id', att, att') alt (filename,_)) - | id' == "demo" || (checkExtension filename demoExt) - = return $ [toHtml $ "
"] - ++ [toHtml $ ""] - ++ [toHtml $ "
"] - ++ alt - ++ [toHtml $ "
"] - where - (direct, css) = classToPlain att --- if not matched -media x = return [x] - - --- | converts Attributes to String for usage in HTML --- --- Also converts width=xxx and height=xxx to the --- corresponding style-attributes -attToString :: Attr -> String -attToString ("", classes, kvpairs) = "class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs') - where - kvpairs' = convertToStyle ["width","height","transform"] kvpairs -attToString (id', classes, kvpairs) = "id=\"" <> id' <> "\" class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs') - where - kvpairs' = convertToStyle ["width","height","transform"] kvpairs - -convertToStyle :: [String] -> [(String,String)] -> [(String,String)] -convertToStyle keys kvpairs = ("style", newstyle):rest - where - oldstyle = case filter (\(k,v) -> k == "style") kvpairs of - [] -> "" - [(_,st)] -> st - stylesToAdd = filter (\(k,v) -> k `elem` keys) kvpairs - rest = filter (\(k,v) -> not $ k `elem` keys) kvpairs - newstyle = concat ((\(k,v) -> k <> ":" <> v <> ";") <$> stylesToAdd) <> oldstyle - -checkExtension :: String -> [String] -> Bool -checkExtension fn exts = (fmap toLower . tail . takeExtension) fn `elem` exts - -idFilter :: String -> String -> String -idFilter a b - | a == b = "" - | otherwise = b - -classToPlain :: [String] -> ([String],[String]) -classToPlain = partition (`elem` [ "data-autoplay" - , "controls" - ] - ) - -toHtml :: String -> Inline -toHtml = RawInline (Format "html") diff --git a/app/Quiz.hs b/app/Quiz.hs index 92db5f3..e5a262f 100644 --- a/app/Quiz.hs +++ b/app/Quiz.hs @@ -2,40 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} import Text.Pandoc.JSON -import Text.Pandoc.Walk -import Control.Exception -import Data.Monoid ((<>)) -import Data.List (partition) -import Data.Maybe (isNothing, mapMaybe, listToMaybe) +import Text.Pandoc.Util.Filter.Quiz main :: IO () -main = toJSONFilter quizLift - --- Move bottom-Up through the structure, find quiz-answers and remove the --- incorrect formattet ones from the Block they came from. -quizLift :: Block -> [Block] -quizLift pb@(Plain b) = fmap makeQuiz (query findQuiz pb) ++ [Plain (filter ((==) [] . findQuiz) b)] -quizLift pb@(Para b) = fmap makeQuiz (query findQuiz pb) ++ [Plain (filter ((==) [] . findQuiz) b)] -quizLift x = [x] - --- If we have []{.answer} then we have a quiz-answer --- maybe with a tooltip -findQuiz :: Inline -> [(Attr, [Inline], Maybe ([Inline],Attr))] -findQuiz (Span attributes@(id, att, att') answerText) - | "answer" `elem` att = [(attributes, answerText', tooltip)] - where - answerText' = filter (isNothing . findTooltip) answerText --filter everything that is a tooltip - tooltip = listToMaybe $ mapMaybe findTooltip answerText --get the first span that is labled tooltip -findQuiz x = [] - --- If we have []{.tooltip} we have a tooltip ;) --- we save the text and the attributes in a tuple -findTooltip :: Inline -> Maybe ([Inline],Attr) -findTooltip (Span attr@(_,att,_) tooltipText) - | "tooltip" `elem` att = Just (tooltipText, attr) -findTooltip _ = Nothing - --- Generate Divs for the quiz -makeQuiz :: (Attr, [Inline], Maybe ([Inline],Attr)) -> Block -makeQuiz (att, answer, Nothing) = Div att [Plain answer] -makeQuiz (att, answer, Just (tooltip,a)) = Div att [Plain answer, Div a [Plain tooltip]] +main = toJSONFilter quiz diff --git a/app/Styling.hs b/app/Styling.hs index f76d609..24843b3 100644 --- a/app/Styling.hs +++ b/app/Styling.hs @@ -1,77 +1,8 @@ #!/usr/bin/env runhaskell -{-# LANGUAGE ScopedTypeVariables #-} import Text.Pandoc.JSON import Text.Pandoc.Walk -import Control.Exception -import Data.Monoid ((<>)) -import Data.List (partition, isInfixOf) +import Text.Pandoc.Util.Filter.Styling main :: IO () main = toJSONFilter $ styling . walk inlineStyling - -styling :: Block -> IO [Block] -styling (Div ("col",att,att') inner) = return $ [toHtml $ "
unwords direct <> attToString ("",css,att') <> ">"] - ++ inner - ++ [toHtml"
"] - where - (direct, css) = classToPlain att -styling (CodeBlock (id,att,att') inner) = return $ [CodeBlock (id, addToAtt "data-trim" - . addToAtt "data-noescape" - $ att - , att') inner] -styling div@(Div (id,att,att') inner) - | "fragment" `elem` att = return [Div (id, att, addToStyle "display: block;" att') inner] - | "frame" `elem` att = return [Div (id, addToAtt "fragment" --insert fragment - . addToAtt "current-visible" --insert current-visible - . filter (/= "frame") --remove frame - $ att - , addToStyle "display: block;" att') inner] - | otherwise = return [div] -styling x = return [x] - - -inlineStyling :: Inline -> Inline -inlineStyling span@(Span (id, att, att') inner) - | "fragment" `elem` att = Span (id, att, addToStyle "display: inline-block;" att') inner - | "frame" `elem` att = Span (id, addToAtt "fragment" --insert fragment - . addToAtt "current-visible" --insert current-visible - . filter (/= "frame") --remove frame - $ att - , addToStyle "display: inline-block;" att') inner - | id == "vspace" = toInlineHtml $ "
unwords direct <> attToString ("",css,att') <> ">
" - | id == "hspace" = toInlineHtml $ " unwords direct <> attToString ("",css,att') <> ">" - | otherwise = span - where - (direct, css) = classToPlain att -inlineStyling x = x - -addToStyle :: String -> [(String, String)] -> [(String, String)] --- we are looking for style and inject -addToStyle toAdd (("style",val):as) = ("style", if toAdd `isInfixOf` val then val else val <> " " <> toAdd):as --- if we land here the current one is not style -> skip -addToStyle toAdd (a:as) = a:addToStyle toAdd as --- if we land here we have no more to skip -> add -addToStyle toAdd [] = [("style", toAdd)] - -addToAtt :: String -> [String] -> [String] -addToAtt toAdd (a:as) - | a == toAdd = toAdd:as - | otherwise = a:addToAtt toAdd as -addToAtt toAdd [] = [toAdd] - -attToString :: Attr -> String -attToString (ident, [], kvpairs) = ident <> " " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs) -attToString (ident, classes, kvpairs) = ident <> " class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs) - -classToPlain :: [String] -> ([String],[String]) -classToPlain = partition (`elem` [ "data-autoplay" - , "controls" - ] - ) - -toHtml :: String -> Block -toHtml = RawBlock (Format "html") - -toInlineHtml :: String -> Inline -toInlineHtml = RawInline (Format "html") diff --git a/doc/Text-Pandoc-Util-Filter-Cols.html b/doc/Text-Pandoc-Util-Filter-Cols.html new file mode 100644 index 0000000..e3dd7ea --- /dev/null +++ b/doc/Text-Pandoc-Util-Filter-Cols.html @@ -0,0 +1,19 @@ +Text.Pandoc.Util.Filter.Cols

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter.Cols

Description

Conversion of lvl-x-headings to x-column-layouts in HTML + especially for use in revealjs-slides

Synopsis

Documentation

cols :: [Block] -> [Block] Source #

This filter makes multi-column-layouts out of lvl-x-headings

Syntax is

    ## a b
+

yielding a 2-column-layout with aspects a:b i.e. 1:1 for 50/50-layout + or 8:2 for 80/20 layout

currently works for 2 and 3-columns, but extension is straight-forward.

If you need multiple Block-Elements inside one column, just wrap them + with a <div>:

    ## 2 5
+
+    <div>
+    multiple things
+    ```
+    foo
+    ```
+    
+    </div>
+
+    second column here with only 1 element.
+
\ No newline at end of file diff --git a/doc/Text-Pandoc-Util-Filter-Media.html b/doc/Text-Pandoc-Util-Filter-Media.html new file mode 100644 index 0000000..0d20d9d --- /dev/null +++ b/doc/Text-Pandoc-Util-Filter-Media.html @@ -0,0 +1,10 @@ +Text.Pandoc.Util.Filter.Media

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter.Media

Synopsis

Documentation

media :: Inline -> IO [Inline] Source #

main media-plugin.

Will convert the following syntax

![](foo.aac){#audio}
+![](foo.mp4){#video}
+![](foo.png){#img}
+![](foo.svg){#svg}
+![](foo.html){#demo}
+

HTML-id's maybe ommitted if the file-extension is in whitelist.

If a type is detected by extension a custom id (not matching the extension) + will be preserved.

\ No newline at end of file diff --git a/doc/Text-Pandoc-Util-Filter-Quiz.html b/doc/Text-Pandoc-Util-Filter-Quiz.html new file mode 100644 index 0000000..6f9d728 --- /dev/null +++ b/doc/Text-Pandoc-Util-Filter-Quiz.html @@ -0,0 +1,4 @@ +Text.Pandoc.Util.Filter.Quiz

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter.Quiz

Documentation

quiz :: Block -> [Block] Source #

\ No newline at end of file diff --git a/doc/Text-Pandoc-Util-Filter-Styling.html b/doc/Text-Pandoc-Util-Filter-Styling.html new file mode 100644 index 0000000..b1b5bf4 --- /dev/null +++ b/doc/Text-Pandoc-Util-Filter-Styling.html @@ -0,0 +1,5 @@ +Text.Pandoc.Util.Filter.Styling

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter.Styling

Documentation

styling :: Block -> IO [Block] Source #

Block-Styling

Special cases captured:

  • #col turns a div into a floating-div for multiple columns
  • CodeBlock gets attributes data-trim and data-noescape + automatically
  • .fragment and .frame work properly on divs

inlineStyling :: Inline -> Inline Source #

Inline-Styling

Special cases captured:

  • .fragment and .frame work properly on spans
  • .vspace inside span adds a vertical space with height=xxx
  • .hspace inside span adds a horizontal space with width=xxx
\ No newline at end of file diff --git a/doc/Text-Pandoc-Util-Filter.html b/doc/Text-Pandoc-Util-Filter.html new file mode 100644 index 0000000..a01e33c --- /dev/null +++ b/doc/Text-Pandoc-Util-Filter.html @@ -0,0 +1,19 @@ +Text.Pandoc.Util.Filter

pandoc-slide-filter-0.1.0.0

Safe HaskellNone
LanguageHaskell2010

Text.Pandoc.Util.Filter

Documentation

attToString :: Attr -> String Source #

converts Attributes to String for usage in HTML

Also converts width=xxx and height=xxx to the + corresponding style-attributes

revealjsSpecialAttrs :: [String] Source #

revealjs has some special attributes that has to be + passed to the html, but Pandoc only allows + key=value-attributes, so we have to abuse + .class to rewrite them.

The classes that get rewritten are listed here.

You probably want classToRevealAttr, as that + is a wrapper for splitting the class-attribute

classToRevealAttr :: [String] -> ([String], [String]) Source #

revealjs has some special attributes that has to be + passed to the html, but Pandoc only allows + key=value-attributes, so we have to abuse + .class to rewrite them.

This is a wrapper-function which just splits the list + into real classes and revealjsSpecialAttrs

toHtml :: String -> Inline Source #

small wrapper around RawInline (Format "html") + as this is less line-noise in the filters and the + intent is more clear.

toBlockHtml :: String -> Block Source #

small wrapper around Raw (Format "html") + as this is less line-noise in the filters and the + intent is more clear.

addToAtt :: Eq a => a -> [a] -> [a] Source #

adds a given String to the list if not in there; Does nothing if the + given String is already present.

addToStyle :: String -> [(String, String)] -> [(String, String)] Source #

adds given String to List of key-value-pairs (like in Attr) + in the "style"-Key.

Useful when trying to add CSS-styles directly to (generated) elements

\ No newline at end of file diff --git a/doc/doc-index.html b/doc/doc-index.html new file mode 100644 index 0000000..6cee2ff --- /dev/null +++ b/doc/doc-index.html @@ -0,0 +1,4 @@ +pandoc-slide-filter-0.1.0.0 (Index)

pandoc-slide-filter-0.1.0.0

\ No newline at end of file diff --git a/doc/haddock-util.js b/doc/haddock-util.js new file mode 100644 index 0000000..92d07d2 --- /dev/null +++ b/doc/haddock-util.js @@ -0,0 +1,316 @@ +// Haddock JavaScript utilities + +var rspace = /\s\s+/g, + rtrim = /^\s+|\s+$/g; + +function spaced(s) { return (" " + s + " ").replace(rspace, " "); } +function trim(s) { return s.replace(rtrim, ""); } + +function hasClass(elem, value) { + var className = spaced(elem.className || ""); + return className.indexOf( " " + value + " " ) >= 0; +} + +function addClass(elem, value) { + var className = spaced(elem.className || ""); + if ( className.indexOf( " " + value + " " ) < 0 ) { + elem.className = trim(className + " " + value); + } +} + +function removeClass(elem, value) { + var className = spaced(elem.className || ""); + className = className.replace(" " + value + " ", " "); + elem.className = trim(className); +} + +function toggleClass(elem, valueOn, valueOff, bool) { + if (bool == null) { bool = ! hasClass(elem, valueOn); } + if (bool) { + removeClass(elem, valueOff); + addClass(elem, valueOn); + } + else { + removeClass(elem, valueOn); + addClass(elem, valueOff); + } + return bool; +} + + +function makeClassToggle(valueOn, valueOff) +{ + return function(elem, bool) { + return toggleClass(elem, valueOn, valueOff, bool); + } +} + +toggleShow = makeClassToggle("show", "hide"); +toggleCollapser = makeClassToggle("collapser", "expander"); + +function toggleSection(id) +{ + var b = toggleShow(document.getElementById("section." + id)); + toggleCollapser(document.getElementById("control." + id), b); + rememberCollapsed(id, b); + return b; +} + +var collapsed = {}; +function rememberCollapsed(id, b) +{ + if(b) + delete collapsed[id] + else + collapsed[id] = null; + + var sections = []; + for(var i in collapsed) + { + if(collapsed.hasOwnProperty(i)) + sections.push(i); + } + // cookie specific to this page; don't use setCookie which sets path=/ + document.cookie = "collapsed=" + escape(sections.join('+')); +} + +function restoreCollapsed() +{ + var cookie = getCookie("collapsed"); + if(!cookie) + return; + + var ids = cookie.split('+'); + for(var i in ids) + { + if(document.getElementById("section." + ids[i])) + toggleSection(ids[i]); + } +} + +function setCookie(name, value) { + document.cookie = name + "=" + escape(value) + ";path=/;"; +} + +function clearCookie(name) { + document.cookie = name + "=;path=/;expires=Thu, 01-Jan-1970 00:00:01 GMT;"; +} + +function getCookie(name) { + var nameEQ = name + "="; + var ca = document.cookie.split(';'); + for(var i=0;i < ca.length;i++) { + var c = ca[i]; + while (c.charAt(0)==' ') c = c.substring(1,c.length); + if (c.indexOf(nameEQ) == 0) { + return unescape(c.substring(nameEQ.length,c.length)); + } + } + return null; +} + + + +var max_results = 75; // 50 is not enough to search for map in the base libraries +var shown_range = null; +var last_search = null; + +function quick_search() +{ + perform_search(false); +} + +function full_search() +{ + perform_search(true); +} + + +function perform_search(full) +{ + var text = document.getElementById("searchbox").value.toLowerCase(); + if (text == last_search && !full) return; + last_search = text; + + var table = document.getElementById("indexlist"); + var status = document.getElementById("searchmsg"); + var children = table.firstChild.childNodes; + + // first figure out the first node with the prefix + var first = bisect(-1); + var last = (first == -1 ? -1 : bisect(1)); + + if (first == -1) + { + table.className = ""; + status.innerHTML = "No results found, displaying all"; + } + else if (first == 0 && last == children.length - 1) + { + table.className = ""; + status.innerHTML = ""; + } + else if (last - first >= max_results && !full) + { + table.className = ""; + status.innerHTML = "More than " + max_results + ", press Search to display"; + } + else + { + // decide what you need to clear/show + if (shown_range) + setclass(shown_range[0], shown_range[1], "indexrow"); + setclass(first, last, "indexshow"); + shown_range = [first, last]; + table.className = "indexsearch"; + status.innerHTML = ""; + } + + + function setclass(first, last, status) + { + for (var i = first; i <= last; i++) + { + children[i].className = status; + } + } + + + // do a binary search, treating 0 as ... + // return either -1 (no 0's found) or location of most far match + function bisect(dir) + { + var first = 0, finish = children.length - 1; + var mid, success = false; + + while (finish - first > 3) + { + mid = Math.floor((finish + first) / 2); + + var i = checkitem(mid); + if (i == 0) i = dir; + if (i == -1) + finish = mid; + else + first = mid; + } + var a = (dir == 1 ? first : finish); + var b = (dir == 1 ? finish : first); + for (var i = b; i != a - dir; i -= dir) + { + if (checkitem(i) == 0) return i; + } + return -1; + } + + + // from an index, decide what the result is + // 0 = match, -1 is lower, 1 is higher + function checkitem(i) + { + var s = getitem(i).toLowerCase().substr(0, text.length); + if (s == text) return 0; + else return (s > text ? -1 : 1); + } + + + // from an index, get its string + // this abstracts over alternates + function getitem(i) + { + for ( ; i >= 0; i--) + { + var s = children[i].firstChild.firstChild.data; + if (s.indexOf(' ') == -1) + return s; + } + return ""; // should never be reached + } +} + +function setSynopsis(filename) { + if (parent.window.synopsis && parent.window.synopsis.location) { + if (parent.window.synopsis.location.replace) { + // In Firefox this avoids adding the change to the history. + parent.window.synopsis.location.replace(filename); + } else { + parent.window.synopsis.location = filename; + } + } +} + +function addMenuItem(html) { + var menu = document.getElementById("page-menu"); + if (menu) { + var btn = menu.firstChild.cloneNode(false); + btn.innerHTML = html; + menu.appendChild(btn); + } +} + +function styles() { + var i, a, es = document.getElementsByTagName("link"), rs = []; + for (i = 0; a = es[i]; i++) { + if(a.rel.indexOf("style") != -1 && a.title) { + rs.push(a); + } + } + return rs; +} + +function addStyleMenu() { + var as = styles(); + var i, a, btns = ""; + for(i=0; a = as[i]; i++) { + btns += "
  • " + + a.title + "
    • " + } + if (as.length > 1) { + var h = "
    " + + "Style ▾" + + "" + + "
    "; + addMenuItem(h); + } +} + +function setActiveStyleSheet(title) { + var as = styles(); + var i, a, found; + for(i=0; a = as[i]; i++) { + a.disabled = true; + // need to do this always, some browsers are edge triggered + if(a.title == title) { + found = a; + } + } + if (found) { + found.disabled = false; + setCookie("haddock-style", title); + } + else { + as[0].disabled = false; + clearCookie("haddock-style"); + } + styleMenu(false); +} + +function resetStyle() { + var s = getCookie("haddock-style"); + if (s) setActiveStyleSheet(s); +} + + +function styleMenu(show) { + var m = document.getElementById('style-menu'); + if (m) toggleShow(m, show); +} + + +function pageLoad() { + addStyleMenu(); + resetStyle(); + restoreCollapsed(); +} + diff --git a/doc/hslogo-16.png b/doc/hslogo-16.png new file mode 100644 index 0000000..0ff8579 Binary files /dev/null and b/doc/hslogo-16.png differ diff --git a/doc/index.html b/doc/index.html new file mode 100644 index 0000000..455e090 --- /dev/null +++ b/doc/index.html @@ -0,0 +1,4 @@ +pandoc-slide-filter-0.1.0.0

    pandoc-slide-filter-0.1.0.0

    pandoc-slide-filter-0.1.0.0

     
    \ No newline at end of file diff --git a/doc/mini_Text-Pandoc-Util-Filter-Cols.html b/doc/mini_Text-Pandoc-Util-Filter-Cols.html new file mode 100644 index 0000000..82a9518 --- /dev/null +++ b/doc/mini_Text-Pandoc-Util-Filter-Cols.html @@ -0,0 +1,4 @@ +Text.Pandoc.Util.Filter.Cols

    Text.Pandoc.Util.Filter.Cols

    cols

    \ No newline at end of file diff --git a/doc/mini_Text-Pandoc-Util-Filter-Media.html b/doc/mini_Text-Pandoc-Util-Filter-Media.html new file mode 100644 index 0000000..a594026 --- /dev/null +++ b/doc/mini_Text-Pandoc-Util-Filter-Media.html @@ -0,0 +1,4 @@ +Text.Pandoc.Util.Filter.Media

    Text.Pandoc.Util.Filter.Media

    media

    \ No newline at end of file diff --git a/doc/mini_Text-Pandoc-Util-Filter-Quiz.html b/doc/mini_Text-Pandoc-Util-Filter-Quiz.html new file mode 100644 index 0000000..ce16022 --- /dev/null +++ b/doc/mini_Text-Pandoc-Util-Filter-Quiz.html @@ -0,0 +1,4 @@ +Text.Pandoc.Util.Filter.Quiz

    Text.Pandoc.Util.Filter.Quiz

    quiz

    \ No newline at end of file diff --git a/doc/mini_Text-Pandoc-Util-Filter-Styling.html b/doc/mini_Text-Pandoc-Util-Filter-Styling.html new file mode 100644 index 0000000..8871214 --- /dev/null +++ b/doc/mini_Text-Pandoc-Util-Filter-Styling.html @@ -0,0 +1,4 @@ +Text.Pandoc.Util.Filter.Styling

    Text.Pandoc.Util.Filter.Styling

    styling

    inlineStyling

    \ No newline at end of file diff --git a/doc/mini_Text-Pandoc-Util-Filter.html b/doc/mini_Text-Pandoc-Util-Filter.html new file mode 100644 index 0000000..e26eafe --- /dev/null +++ b/doc/mini_Text-Pandoc-Util-Filter.html @@ -0,0 +1,4 @@ +Text.Pandoc.Util.Filter

    Text.Pandoc.Util.Filter

    attToString

    revealjsSpecialAttrs

    classToRevealAttr

    toHtml

    toBlockHtml

    addToAtt

    addToStyle

    \ No newline at end of file diff --git a/doc/minus.gif b/doc/minus.gif new file mode 100644 index 0000000..1deac2f Binary files /dev/null and b/doc/minus.gif differ diff --git a/doc/ocean.css b/doc/ocean.css new file mode 100644 index 0000000..e8e4d70 --- /dev/null +++ b/doc/ocean.css @@ -0,0 +1,612 @@ +/* @group Fundamentals */ + +* { margin: 0; padding: 0 } + +/* Is this portable? */ +html { + background-color: white; + width: 100%; + height: 100%; +} + +body { + background: white; + color: black; + text-align: left; + min-height: 100%; + position: relative; +} + +p { + margin: 0.8em 0; +} + +ul, ol { + margin: 0.8em 0 0.8em 2em; +} + +dl { + margin: 0.8em 0; +} + +dt { + font-weight: bold; +} +dd { + margin-left: 2em; +} + +a { text-decoration: none; } +a[href]:link { color: rgb(196,69,29); } +a[href]:visited { color: rgb(171,105,84); } +a[href]:hover { text-decoration:underline; } + +a[href].def:link, a[href].def:visited { color: black; } +a[href].def:hover { color: rgb(78, 98, 114); } + +/* @end */ + +/* @group Fonts & Sizes */ + +/* Basic technique & IE workarounds from YUI 3 + For reasons, see: + http://yui.yahooapis.com/3.1.1/build/cssfonts/fonts.css + */ + +body { + font:13px/1.4 sans-serif; + *font-size:small; /* for IE */ + *font:x-small; /* for IE in quirks mode */ +} + +h1 { font-size: 146.5%; /* 19pt */ } +h2 { font-size: 131%; /* 17pt */ } +h3 { font-size: 116%; /* 15pt */ } +h4 { font-size: 100%; /* 13pt */ } +h5 { font-size: 100%; /* 13pt */ } + +select, input, button, textarea { + font:99% sans-serif; +} + +table { + font-size:inherit; + font:100%; +} + +pre, code, kbd, samp, tt, .src { + font-family:monospace; + *font-size:108%; + line-height: 124%; +} + +.links, .link { + font-size: 85%; /* 11pt */ +} + +#module-header .caption { + font-size: 182%; /* 24pt */ +} + +.info { + font-size: 85%; /* 11pt */ +} + +#table-of-contents, #synopsis { + /* font-size: 85%; /* 11pt */ +} + + +/* @end */ + +/* @group Common */ + +.caption, h1, h2, h3, h4, h5, h6 { + font-weight: bold; + color: rgb(78,98,114); + margin: 0.8em 0 0.4em; +} + +* + h1, * + h2, * + h3, * + h4, * + h5, * + h6 { + margin-top: 2em; +} + +h1 + h2, h2 + h3, h3 + h4, h4 + h5, h5 + h6 { + margin-top: inherit; +} + +ul.links { + list-style: none; + text-align: left; + float: right; + display: inline-table; + margin: 0 0 0 1em; +} + +ul.links li { + display: inline; + border-left: 1px solid #d5d5d5; + white-space: nowrap; + padding: 0; +} + +ul.links li a { + padding: 0.2em 0.5em; +} + +.hide { display: none; } +.show { display: inherit; } +.clear { clear: both; } + +.collapser { + background-image: url(minus.gif); + background-repeat: no-repeat; +} +.expander { + background-image: url(plus.gif); + background-repeat: no-repeat; +} +.collapser, .expander { + padding-left: 14px; + margin-left: -14px; + cursor: pointer; +} +p.caption.collapser, +p.caption.expander { + background-position: 0 0.4em; +} + +.instance.collapser, .instance.expander { + margin-left: 0px; + background-position: left center; + min-width: 9px; + min-height: 9px; +} + + +pre { + padding: 0.25em; + margin: 0.8em 0; + background: rgb(229,237,244); + overflow: auto; + border-bottom: 0.25em solid white; + /* white border adds some space below the box to compensate + for visual extra space that paragraphs have between baseline + and the bounding box */ +} + +.src { + background: #f0f0f0; + padding: 0.2em 0.5em; +} + +.keyword { font-weight: normal; } +.def { font-weight: bold; } + +@media print { + #footer { display: none; } +} + +/* @end */ + +/* @group Page Structure */ + +#content { + margin: 0 auto; + padding: 0 2em 6em; +} + +#package-header { + background: rgb(41,56,69); + border-top: 5px solid rgb(78,98,114); + color: #ddd; + padding: 0.2em; + position: relative; + text-align: left; +} + +#package-header .caption { + background: url(hslogo-16.png) no-repeat 0em; + color: white; + margin: 0 2em; + font-weight: normal; + font-style: normal; + padding-left: 2em; +} + +#package-header a:link, #package-header a:visited { color: white; } +#package-header a:hover { background: rgb(78,98,114); } + +#module-header .caption { + color: rgb(78,98,114); + font-weight: bold; + border-bottom: 1px solid #ddd; +} + +table.info { + float: right; + padding: 0.5em 1em; + border: 1px solid #ddd; + color: rgb(78,98,114); + background-color: #fff; + max-width: 40%; + border-spacing: 0; + position: relative; + top: -0.5em; + margin: 0 0 0 2em; +} + +.info th { + padding: 0 1em 0 0; +} + +div#style-menu-holder { + position: relative; + z-index: 2; + display: inline; +} + +#style-menu { + position: absolute; + z-index: 1; + overflow: visible; + background: #374c5e; + margin: 0; + text-align: center; + right: 0; + padding: 0; + top: 1.25em; +} + +#style-menu li { + display: list-item; + border-style: none; + margin: 0; + padding: 0; + color: #000; + list-style-type: none; +} + +#style-menu li + li { + border-top: 1px solid #919191; +} + +#style-menu a { + width: 6em; + padding: 3px; + display: block; +} + +#footer { + background: #ddd; + border-top: 1px solid #aaa; + padding: 0.5em 0; + color: #666; + text-align: center; + position: absolute; + bottom: 0; + width: 100%; + height: 3em; +} + +/* @end */ + +/* @group Front Matter */ + +#table-of-contents { + float: right; + clear: right; + background: #faf9dc; + border: 1px solid #d8d7ad; + padding: 0.5em 1em; + max-width: 20em; + margin: 0.5em 0 1em 1em; +} + +#table-of-contents .caption { + text-align: center; + margin: 0; +} + +#table-of-contents ul { + list-style: none; + margin: 0; +} + +#table-of-contents ul ul { + margin-left: 2em; +} + +#description .caption { + display: none; +} + +#synopsis { + display: none; +} + +.no-frame #synopsis { + display: block; + position: fixed; + right: 0; + height: 80%; + top: 10%; + padding: 0; + max-width: 75%; + /* Ensure that synopsis covers everything (including MathJAX markup) */ + z-index: 1; +} + +#synopsis .caption { + float: left; + width: 29px; + color: rgba(255,255,255,0); + height: 110px; + margin: 0; + font-size: 1px; + padding: 0; +} + +#synopsis p.caption.collapser { + background: url(synopsis.png) no-repeat -64px -8px; +} + +#synopsis p.caption.expander { + background: url(synopsis.png) no-repeat 0px -8px; +} + +#synopsis ul { + height: 100%; + overflow: auto; + padding: 0.5em; + margin: 0; +} + +#synopsis ul ul { + overflow: hidden; +} + +#synopsis ul, +#synopsis ul li.src { + background-color: #faf9dc; + white-space: nowrap; + list-style: none; + margin-left: 0; +} + +/* @end */ + +/* @group Main Content */ + +#interface div.top { margin: 2em 0; } +#interface h1 + div.top, +#interface h2 + div.top, +#interface h3 + div.top, +#interface h4 + div.top, +#interface h5 + div.top { + margin-top: 1em; +} +#interface .src .selflink, +#interface .src .link { + float: right; + color: #919191; + background: #f0f0f0; + padding: 0 0.5em 0.2em; + margin: 0 -0.5em 0 0; +} +#interface .src .selflink { + border-left: 1px solid #919191; + margin: 0 -0.5em 0 0.5em; +} + +#interface span.fixity { + color: #919191; + border-left: 1px solid #919191; + padding: 0.2em 0.5em 0.2em 0.5em; + margin: 0 -1em 0 1em; +} + +#interface span.rightedge { + border-left: 1px solid #919191; + padding: 0.2em 0 0.2em 0; + margin: 0 0 0 1em; +} + +#interface table { border-spacing: 2px; } +#interface td { + vertical-align: top; + padding-left: 0.5em; +} +#interface td.src { + white-space: nowrap; +} +#interface td.doc p { + margin: 0; +} +#interface td.doc p + p { + margin-top: 0.8em; +} + +.clearfix:after { + clear: both; + content: " "; + display: block; + height: 0; + visibility: hidden; +} + +.subs ul { + list-style: none; + display: table; + margin: 0; +} + +.subs ul li { + display: table-row; +} + +.subs ul li dfn { + display: table-cell; + font-style: normal; + font-weight: bold; + margin: 1px 0; + white-space: nowrap; +} + +.subs ul li > .doc { + display: table-cell; + padding-left: 0.5em; + margin-bottom: 0.5em; +} + +.subs ul li > .doc p { + margin: 0; +} + +/* Render short-style data instances */ +.inst ul { + height: 100%; + padding: 0.5em; + margin: 0; +} + +.inst, .inst li { + list-style: none; + margin-left: 1em; +} + +/* Workaround for bug in Firefox (issue #384) */ +.inst-left { + float: left; +} + +.top p.src { + border-top: 1px solid #ccc; +} + +.subs, .doc { + /* use this selector for one level of indent */ + padding-left: 2em; +} + +.warning { + color: red; +} + +.arguments { + margin-top: -0.4em; +} +.arguments .caption { + display: none; +} + +.fields { padding-left: 1em; } + +.fields .caption { display: none; } + +.fields p { margin: 0 0; } + +/* this seems bulky to me +.methods, .constructors { + background: #f8f8f8; + border: 1px solid #eee; +} +*/ + +/* @end */ + +/* @group Auxillary Pages */ + + +.extension-list { + list-style-type: none; + margin-left: 0; +} + +#mini { + margin: 0 auto; + padding: 0 1em 1em; +} + +#mini > * { + font-size: 93%; /* 12pt */ +} + +#mini #module-list .caption, +#mini #module-header .caption { + font-size: 125%; /* 15pt */ +} + +#mini #interface h1, +#mini #interface h2, +#mini #interface h3, +#mini #interface h4 { + font-size: 109%; /* 13pt */ + margin: 1em 0 0; +} + +#mini #interface .top, +#mini #interface .src { + margin: 0; +} + +#mini #module-list ul { + list-style: none; + margin: 0; +} + +#alphabet ul { + list-style: none; + padding: 0; + margin: 0.5em 0 0; + text-align: center; +} + +#alphabet li { + display: inline; + margin: 0 0.25em; +} + +#alphabet a { + font-weight: bold; +} + +#index .caption, +#module-list .caption { font-size: 131%; /* 17pt */ } + +#index table { + margin-left: 2em; +} + +#index .src { + font-weight: bold; +} +#index .alt { + font-size: 77%; /* 10pt */ + font-style: italic; + padding-left: 2em; +} + +#index td + td { + padding-left: 1em; +} + +#module-list ul { + list-style: none; + margin: 0 0 0 2em; +} + +#module-list li { + clear: right; +} + +#module-list span.collapser, +#module-list span.expander { + background-position: 0 0.3em; +} + +#module-list .package { + float: right; +} + +/* @end */ diff --git a/doc/pandoc-slide-filter.haddock b/doc/pandoc-slide-filter.haddock new file mode 100644 index 0000000..07b4959 Binary files /dev/null and b/doc/pandoc-slide-filter.haddock differ diff --git a/doc/plus.gif b/doc/plus.gif new file mode 100644 index 0000000..2d15c14 Binary files /dev/null and b/doc/plus.gif differ diff --git a/doc/src/Text.Pandoc.Util.Filter.Cols.html b/doc/src/Text.Pandoc.Util.Filter.Cols.html new file mode 100644 index 0000000..c052980 --- /dev/null +++ b/doc/src/Text.Pandoc.Util.Filter.Cols.html @@ -0,0 +1,79 @@ +
    {-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Conversion of lvl-x-headings to x-column-layouts in HTML
+--   especially for use in revealjs-slides
+module Text.Pandoc.Util.Filter.Cols
+    (cols)
+        where
+
+import Text.Pandoc.JSON
+import Data.Monoid ((<>))
+import Text.Read (readMaybe)
+import Data.Maybe (fromMaybe)
+import Text.Pandoc.Util.Filter
+
+-- | This filter makes multi-column-layouts out of lvl-x-headings
+--
+-- Syntax is
+-- 
+-- @
+--     ## a b
+-- @
+--
+-- yielding a 2-column-layout with aspects a:b i.e. 1:1 for 50/50-layout
+-- or 8:2 for 80/20 layout
+--
+-- currently works for 2 and 3-columns, but extension is straight-forward.
+--
+-- If you need multiple Block-Elements inside one column, just wrap them
+-- with a @\<div\>@:
+--
+-- @
+--     ## 2 5
+--
+--     \<div\>
+--     multiple things
+--     ```
+--     foo
+--     ```
+--     ![image](...)
+--     \</div\>
+--
+--     second column here with only 1 element.
+-- @
+cols :: [Block] -> [Block]
+cols (Header 2 attr [Str wa,Space,Str wb]:a:b:rest) =
+  outerDiv:rest
+    where
+      wa' = fromMaybe 1 (readMaybe wa) :: Int
+      wb' = fromMaybe 1 (readMaybe wb) :: Int
+      total = wa' + wb'
+      pa = (100*wa') `div` total
+      pb = (100*wb') `div` total
+      outerDiv = Div attr [ makeDiv pa a
+                          , makeDiv pb b
+                          , clearDiv
+                          ]
+cols (Header 3 attr [Str wa,Space,Str wb,Space,Str wc]:a:b:c:rest) =
+  outerDiv:rest
+    where
+      wa' = fromMaybe 1 (readMaybe wa) :: Int
+      wb' = fromMaybe 1 (readMaybe wb) :: Int
+      wc' = fromMaybe 1 (readMaybe wc) :: Int
+      total = wa' + wb' + wc'
+      pa = (100*wa') `div` total
+      pb = (100*wb') `div` total
+      pc = (100*wc') `div` total
+      outerDiv = Div attr [ makeDiv pa a
+                          , makeDiv pb b
+                          , makeDiv pc c
+                          , clearDiv
+                          ]
+cols x = x
+
+makeDiv :: Int -> Block -> Block
+makeDiv width content = Div ("", [], [("style","width:" <> show width <> "%;float:left")]) [content]
+
+clearDiv :: Block
+clearDiv = Div ("", [], [("style", "clear: both")]) [Plain [toHtml "&nbsp;"]]
+
    \ No newline at end of file diff --git a/doc/src/Text.Pandoc.Util.Filter.Media.html b/doc/src/Text.Pandoc.Util.Filter.Media.html new file mode 100644 index 0000000..8869272 --- /dev/null +++ b/doc/src/Text.Pandoc.Util.Filter.Media.html @@ -0,0 +1,159 @@ +
    {-# LANGUAGE ScopedTypeVariables #-}
+
+module Text.Pandoc.Util.Filter.Media
+    (media)
+        where
+
+import Text.Pandoc.JSON
+import Control.Exception
+import Data.Monoid ((<>))
+import Data.Char (toLower)
+import System.FilePath
+
+import Text.Pandoc.Util.Filter
+
+{-# ANN module "HLint: ignore Redundant $" #-} -- supress HLint-Warnings about $
+
+-- | File-extensions that should be treated as audio
+audioExt :: [String]
+audioExt = ["mp3","aac"]
+
+-- | File-extensions that should be treated as video
+videoExt :: [String]
+videoExt = [ "avi"
+           , "mp4"
+           , "mov"
+           ]
+
+-- | File-extensions that should be treated as image
+imgExt :: [String]
+imgExt = 
+  [ "jpg"
+  , "jpeg"
+  , "png"
+  , "gif"
+  , "tif"
+  , "tiff"
+  , "bmp"
+  , "svg"
+  ]
+
+-- | File-extensions that should be treated as demo and will be included
+-- in an iframe
+demoExt :: [String]
+demoExt = ["html", "htm"]
+
+-- | main media-plugin.
+--
+-- Will convert the following syntax
+--
+-- @
+-- ![](foo.aac){#audio}
+-- ![](foo.mp4){#video}
+-- ![](foo.png){#img}
+-- ![](foo.svg){#svg}
+-- ![](foo.html){#demo}
+-- @
+--
+-- HTML-id's maybe ommitted if the file-extension is in whitelist.
+--
+-- If a type is detected by extension a custom id (not matching the extension)
+-- will be preserved.
+--
+media :: Inline -> IO [Inline]
+--audio
+media (Image (id',att,att') [] (filename,_))
+  | id' == "audio" || checkExtension filename audioExt
+    = return $ [toHtml $ "<audio " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "audio" id',css,att') <> "></audio>"]
+      where
+        (direct, css) = classToRevealAttr att
+media (Image (id',att,att') alt (filename,_))
+  | id' == "audio" || checkExtension filename audioExt
+    = return $ [toHtml $ "<figure><audio " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "audio" id',css,att') <> "></audio>"]
+            <> [toHtml $ "<figcaption>"]
+            <> alt
+            <> [toHtml $ "</figcaption></figure>"]
+      where
+        (direct, css) = classToRevealAttr att
+--videos
+media (Image (id', att, att') [] (filename,_))
+  | id' == "video" || checkExtension filename videoExt
+    = return $ [toHtml $ "<video " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "video" id',css,att') <> "></video>"]
+      where
+        (direct, css) = classToRevealAttr att
+media (Image (id', att, att') alt (filename,_))
+  | id' == "video" || checkExtension filename videoExt
+     = return $ [toHtml $ "<figure>"]
+             <> [toHtml $ "<video " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "video" id',css,att') <> "></video>"]
+             <> [toHtml $ "<figcaption>"]
+             <> alt
+             <> [toHtml $ "</figcaption></figure>"]
+       where
+         (direct, css) = classToRevealAttr att
+--images
+media (Image (id', att, att') [] (filename,_))
+  | id' == "img" || checkExtension filename imgExt
+    = return $ [toHtml $ "<figure>"]
+            <> [toHtml $ "<img " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> "></img>"]
+            <> [toHtml $ "</figure>"]
+      where
+        (direct, css) = classToRevealAttr att
+media (Image (id', att, att') alt (filename,_))
+  | id' == "img" || checkExtension filename imgExt
+    = return $ [toHtml $ "<figure>"]
+            <> [toHtml $ "<img " <> unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> "></img>"]
+            <> [toHtml $ "<figcaption>"]
+            <> alt
+            <> [toHtml $ "</figcaption></figure>"]
+      where
+        (direct, css) = classToRevealAttr att
+--load svg and dump it in
+media (Image (id', att, att') [] (filename,_))
+  | id' == "svg"
+    = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "<br />" <> show fileerror]) $
+                do
+                  svg <- readFile filename
+                  return $ [toHtml $ "<figure " <> unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"] -- use attributes on figure, as svg gets dumped in..
+                        <> [toHtml $ svg]
+                        <> [toHtml $ "</figure>"]
+      where
+        (direct, css) = classToRevealAttr att
+media (Image (id', att, att') alt (filename,_))
+  | id' == "svg"
+    = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "<br />" <> show fileerror]) $
+                do
+                  svg <- readFile filename
+                  return $ [toHtml $ "<figure " <> unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"] -- use attributes on figure, as svg gets dumped in..
+                        <> [toHtml $ svg]
+                        <> [toHtml $ "<figcaption>"]
+                        <> alt
+                        <> [toHtml $ "</figcaption></figure>"]
+      where
+        (direct, css) = classToRevealAttr att
+--html-demos etc. as IFrames
+media (Image (id', att, att') [] (filename,_))
+  | id' == "demo" || checkExtension filename demoExt
+    = return [toHtml $ "<iframe " <> unwords direct <> " src=\"" <> filename <> "?plugin\"" <> attToString (idFilter "demo" id', css, att') <> "></iframe>"]
+      where
+        (direct, css) = classToRevealAttr att
+media (Image (id', att, att') alt (filename,_))
+  | id' == "demo" || checkExtension filename demoExt
+    = return $ [toHtml $ "<figure>"]
+            <> [toHtml $ "<iframe " <> unwords direct <> " src=\"" <> filename <> "?plugin\"" <> attToString (idFilter "demo" id', css, att') <> "></iframe>"]
+            <> [toHtml $ "<figcaption>"]
+            <> alt
+            <> [toHtml $ "</figcaption></figure>"]
+      where
+        (direct, css) = classToRevealAttr att
+-- if not matched
+media x = return [x]
+
+checkExtension :: String -> [String] -> Bool
+checkExtension fn exts = (fmap toLower . tail . takeExtension) fn `elem` exts
+
+idFilter :: String -> String -> String
+idFilter a b
+  | a == b    = ""
+  | otherwise = b
+
+
    \ No newline at end of file diff --git a/doc/src/Text.Pandoc.Util.Filter.Quiz.html b/doc/src/Text.Pandoc.Util.Filter.Quiz.html new file mode 100644 index 0000000..173a581 --- /dev/null +++ b/doc/src/Text.Pandoc.Util.Filter.Quiz.html @@ -0,0 +1,40 @@ +
    {-# LANGUAGE ScopedTypeVariables #-}
+
+module Text.Pandoc.Util.Filter.Quiz
+    (quiz)
+        where
+
+import Text.Pandoc.JSON
+import Text.Pandoc.Walk
+import Data.Monoid ((<>))
+import Data.Maybe (isNothing, mapMaybe, listToMaybe)
+
+-- Move bottom-Up through the structure, find quiz-answers and remove the
+-- incorrect formattet ones from the Block they came from.
+quiz :: Block -> [Block]
+quiz pb@(Plain b) = fmap makeQuiz (query findQuiz pb) <> [Plain (filter ((==) [] . findQuiz) b)]
+quiz pb@(Para  b) = fmap makeQuiz (query findQuiz pb) <> [Plain (filter ((==) [] . findQuiz) b)]
+quiz x = [x]
+
+-- If we have []{.answer} then we have a quiz-answer
+-- maybe with a tooltip
+findQuiz :: Inline -> [(Attr, [Inline], Maybe ([Inline],Attr))]
+findQuiz (Span attributes@(_, att, _) answerText)
+  | "answer" `elem` att     = [(attributes, answerText', tooltip)]
+                where
+                        answerText' = filter (isNothing . findTooltip) answerText   --filter everything that is a tooltip
+                        tooltip     = listToMaybe $ mapMaybe findTooltip answerText --get the first span that is labled tooltip
+findQuiz _ = []
+
+-- If we have []{.tooltip} we have a tooltip ;)
+-- we save the text and the attributes in a tuple
+findTooltip :: Inline -> Maybe ([Inline],Attr)
+findTooltip (Span attr@(_,att,_) tooltipText)
+  | "tooltip" `elem` att    = Just (tooltipText, attr)
+findTooltip _ = Nothing
+
+-- Generate Divs for the quiz
+makeQuiz :: (Attr, [Inline], Maybe ([Inline],Attr)) -> Block
+makeQuiz (att, answer, Nothing) = Div att [Plain answer]
+makeQuiz (att, answer, Just (tooltip,a)) = Div att [Plain answer, Div a [Plain tooltip]]
+
    \ No newline at end of file diff --git a/doc/src/Text.Pandoc.Util.Filter.Styling.html b/doc/src/Text.Pandoc.Util.Filter.Styling.html new file mode 100644 index 0000000..cb97efb --- /dev/null +++ b/doc/src/Text.Pandoc.Util.Filter.Styling.html @@ -0,0 +1,65 @@ +
    {-# LANGUAGE ScopedTypeVariables #-}
+
+module Text.Pandoc.Util.Filter.Styling
+    (styling, inlineStyling)
+        where
+
+import Text.Pandoc.JSON
+import Data.Monoid ((<>))
+import Text.Pandoc.Util.Filter
+import Prelude hiding (div, span)
+
+-- | Block-Styling
+--
+--   Special cases captured:
+--
+--   - #col turns a div into a floating-div for multiple columns
+--   - CodeBlock gets attributes @data-trim@ and @data-noescape@
+--     automatically
+--   - .fragment and .frame work properly on divs
+styling :: Block -> IO [Block]
+styling (Div ("col",att,att') inner)   = return $ [toBlockHtml $ "<div style=\"float:left; margin-bottom:10px;\"" <> unwords direct <> attToString ("",css,att') <> ">"]
+                                                        ++ inner
+                                                        ++ [toBlockHtml"</div>"]
+                                        where
+                                                        (direct, css) = classToRevealAttr att
+styling (CodeBlock (id',att,att') inner)   = return
+                            [CodeBlock (id', addToAtt "data-trim"
+                                           . addToAtt "data-noescape"
+                                           $ att
+                                           , att')
+                                       inner]
+styling div@(Div (id',att,att') inner)
+  | "fragment" `elem` att = return [Div (id', att, addToStyle "display: block;" att') inner]
+  | "frame" `elem` att    = return [Div (id', addToAtt "fragment"        --insert fragment
+                                           . addToAtt "current-visible" --insert current-visible
+                                           . filter (/= "frame")        --remove frame
+                                           $ att
+                                           , addToStyle "display: block;" att') inner]
+  | otherwise             = return [div]
+styling x = return [x]
+
+
+-- | Inline-Styling
+--
+--   Special cases captured:
+--
+--   - .fragment and .frame work properly on spans
+--   - .vspace inside span adds a vertical space with @height=xxx@
+--   - .hspace inside span adds a horizontal space with @width=xxx@
+inlineStyling :: Inline -> Inline
+inlineStyling span@(Span (id', att, att') inner)
+  | "fragment" `elem` att = Span (id', att, addToStyle "display: inline-block;" att') inner
+  | "frame" `elem` att    = Span (id', addToAtt "fragment"        --insert fragment
+                                    . addToAtt "current-visible" --insert current-visible
+                                    . filter (/= "frame")        --remove frame
+                                    $ att
+                                    , addToStyle "display: inline-block;" att') inner
+  | id' == "vspace"        = toHtml $ "<div style=\"clear:both;\"" <> unwords direct <> attToString ("",css,att') <> "></div>"
+  | id' == "hspace"        = toHtml $ "<span " <> unwords direct <> attToString ("",css,att') <> "></span>"
+  | otherwise             = span
+                                where
+                                        (direct, css) = classToRevealAttr att
+inlineStyling x = x
+
+
    \ No newline at end of file diff --git a/doc/src/Text.Pandoc.Util.Filter.html b/doc/src/Text.Pandoc.Util.Filter.html new file mode 100644 index 0000000..30aa29d --- /dev/null +++ b/doc/src/Text.Pandoc.Util.Filter.html @@ -0,0 +1,103 @@ +
    module Text.Pandoc.Util.Filter
+    ( attToString
+    , revealjsSpecialAttrs
+    , classToRevealAttr
+    , toHtml
+    , toBlockHtml
+    , addToAtt
+    , addToStyle
+    )
+   where
+
+import Text.Pandoc.Definition
+import Data.Monoid
+import Data.List (partition, isInfixOf)
+
+-- | adds a given String to the list if not in there; Does nothing if the
+--   given String is already present.
+addToAtt :: Eq a => a -> [a] -> [a]
+addToAtt toAdd (a:as)
+  | a == toAdd    = toAdd:as
+  | otherwise     = a:addToAtt toAdd as
+addToAtt toAdd [] = [toAdd]
+
+-- | adds given String to List of key-value-pairs (like in 'Attr')
+--   in the \"style\"-Key.
+--
+--   Useful when trying to add CSS-styles directly to (generated) elements
+addToStyle :: String -> [(String, String)] -> [(String, String)]
+-- we are looking for style and inject
+addToStyle toAdd (("style",val):as) = ("style", if toAdd `isInfixOf` val then val else val <> " " <> toAdd):as
+-- if we land here the current one is not style -> skip
+addToStyle toAdd (a:as)             = a:addToStyle toAdd as
+-- if we land here we have no more to skip -> add
+addToStyle toAdd []                 = [("style", toAdd)]
+
+-- | converts Attributes to String for usage in HTML
+--
+-- Also converts @width=xxx@ and @height=xxx@ to the
+-- corresponding style-attributes
+attToString :: Attr -> String
+attToString ("", classes, kvpairs) = "class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs')
+  where
+    kvpairs' = convertToStyle ["width","height","transform"] kvpairs
+attToString (id', classes, kvpairs) = "id=\"" <> id'  <> "\" class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs')
+  where
+    kvpairs' = convertToStyle ["width","height","transform"] kvpairs
+
+convertToStyle :: [String] -> [(String,String)] -> [(String,String)]
+convertToStyle keys kvpairs = ("style", newstyle):rest
+  where
+    oldstyle = case filter (\(k,_) -> k == "style") kvpairs of
+                 [(_,st)] -> st
+                 _        -> ""
+    stylesToAdd = filter (\(k,_) -> k    `elem` keys) kvpairs
+    rest        = filter (\(k,_) -> k `notElem` keys) kvpairs
+    newstyle = concat ((\(k,v) -> k <> ":" <> v <> ";") <$> stylesToAdd) <> oldstyle
+
+-- | revealjs has some special attributes that has to be
+--   passed to the html, but Pandoc only allows
+--   @key=value@-attributes, so we have to abuse
+--   @.class@ to rewrite them.
+--
+--   The classes that get rewritten are listed here.
+--
+--   You probably want 'classToRevealAttr', as that
+--   is a wrapper for splitting the class-attribute
+revealjsSpecialAttrs :: [String]
+revealjsSpecialAttrs = 
+    [ "data-markdown"
+    , "data-timing"
+    , "data-template"
+    , "data-autoplay"
+    , "data-prevent-swipe"
+    , "data-background-interactive"
+    , "data-trim"
+    , "data-noescape"
+    , "data-ignore"
+    , "controls"
+    ]
+
+-- | revealjs has some special attributes that has to be
+--   passed to the html, but Pandoc only allows
+--   @key=value@-attributes, so we have to abuse
+--   @.class@ to rewrite them.
+--
+--   This is a wrapper-function which just splits the list
+--   into real classes and 'revealjsSpecialAttrs'
+classToRevealAttr :: [String] -> ([String],[String])
+classToRevealAttr = partition (`elem` revealjsSpecialAttrs)
+
+-- | small wrapper around @RawInline (Format "html")@
+--   as this is less line-noise in the filters and the
+--   intent is more clear.
+toHtml :: String -> Inline
+toHtml = RawInline (Format "html")
+
+
+-- | small wrapper around @Raw (Format "html")@
+--   as this is less line-noise in the filters and the
+--   intent is more clear.
+toBlockHtml :: String -> Block
+toBlockHtml = RawBlock (Format "html")
+
    \ No newline at end of file diff --git a/doc/src/highlight.js b/doc/src/highlight.js new file mode 100644 index 0000000..1e903bd --- /dev/null +++ b/doc/src/highlight.js @@ -0,0 +1,27 @@ + +var highlight = function (on) { + return function () { + var links = document.getElementsByTagName('a'); + for (var i = 0; i < links.length; i++) { + var that = links[i]; + + if (this.href != that.href) { + continue; + } + + if (on) { + that.classList.add("hover-highlight"); + } else { + that.classList.remove("hover-highlight"); + } + } + } +}; + +window.onload = function () { + var links = document.getElementsByTagName('a'); + for (var i = 0; i < links.length; i++) { + links[i].onmouseover = highlight(true); + links[i].onmouseout = highlight(false); + } +}; diff --git a/doc/src/style.css b/doc/src/style.css new file mode 100644 index 0000000..e83dc5e --- /dev/null +++ b/doc/src/style.css @@ -0,0 +1,55 @@ +body { + background-color: #fdf6e3; +} + +.hs-identifier { + color: #073642; +} + +.hs-identifier.hs-var { +} + +.hs-identifier.hs-type { + color: #5f5faf; +} + +.hs-keyword { + color: #af005f; +} + +.hs-string, .hs-char { + color: #cb4b16; +} + +.hs-number { + color: #268bd2; +} + +.hs-operator { + color: #d33682; +} + +.hs-glyph, .hs-special { + color: #dc322f; +} + +.hs-comment { + color: #8a8a8a; +} + +.hs-pragma { + color: #2aa198; +} + +.hs-cpp { + color: #859900; +} + +a:link, a:visited { + text-decoration: none; + border-bottom: 1px solid #eee8d5; +} + +a:hover, a.hover-highlight { + background-color: #eee8d5; +} diff --git a/doc/synopsis.png b/doc/synopsis.png new file mode 100644 index 0000000..85fb86e Binary files /dev/null and b/doc/synopsis.png differ diff --git a/pandoc-slide-filter.cabal b/pandoc-slide-filter.cabal index 0167c56..5fe8bb6 100644 --- a/pandoc-slide-filter.cabal +++ b/pandoc-slide-filter.cabal @@ -19,7 +19,7 @@ executable media ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base , pandoc-types - , filepath + , pandoc-slide-filter default-language: Haskell2010 executable cols @@ -28,7 +28,7 @@ executable cols ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base , pandoc-types - , filepath + , pandoc-slide-filter default-language: Haskell2010 executable styling @@ -37,6 +37,7 @@ executable styling ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base , pandoc-types + , pandoc-slide-filter default-language: Haskell2010 executable quiz @@ -45,6 +46,7 @@ executable quiz ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base , pandoc-types + , pandoc-slide-filter default-language: Haskell2010 executable clean @@ -53,8 +55,21 @@ executable clean ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base , pandoc-types + , pandoc-slide-filter default-language: Haskell2010 +library + hs-source-dirs: src + build-depends: base + , pandoc-types + , filepath + default-language: Haskell2010 + exposed-modules: Text.Pandoc.Util.Filter + , Text.Pandoc.Util.Filter.Cols + , Text.Pandoc.Util.Filter.Media + , Text.Pandoc.Util.Filter.Styling + , Text.Pandoc.Util.Filter.Quiz + source-repository head type: git location: https://github.com/Drezil/pandoc-slide-filter diff --git a/src/Text/Pandoc/Util/Filter.hs b/src/Text/Pandoc/Util/Filter.hs new file mode 100644 index 0000000..5d8275b --- /dev/null +++ b/src/Text/Pandoc/Util/Filter.hs @@ -0,0 +1,102 @@ +module Text.Pandoc.Util.Filter + ( attToString + , revealjsSpecialAttrs + , classToRevealAttr + , toHtml + , toBlockHtml + , addToAtt + , addToStyle + ) + where + +import Text.Pandoc.Definition +import Data.Monoid +import Data.List (partition, isInfixOf) + +-- | adds a given String to the list if not in there; Does nothing if the +-- given String is already present. +addToAtt :: Eq a => a -> [a] -> [a] +addToAtt toAdd (a:as) + | a == toAdd = toAdd:as + | otherwise = a:addToAtt toAdd as +addToAtt toAdd [] = [toAdd] + +-- | adds given String to List of key-value-pairs (like in 'Attr') +-- in the \"style\"-Key. +-- +-- Useful when trying to add CSS-styles directly to (generated) elements +addToStyle :: String -> [(String, String)] -> [(String, String)] +-- we are looking for style and inject +addToStyle toAdd (("style",val):as) = ("style", if toAdd `isInfixOf` val then val else val <> " " <> toAdd):as +-- if we land here the current one is not style -> skip +addToStyle toAdd (a:as) = a:addToStyle toAdd as +-- if we land here we have no more to skip -> add +addToStyle toAdd [] = [("style", toAdd)] + +-- | converts Attributes to String for usage in HTML +-- +-- Also converts @width=xxx@ and @height=xxx@ to the +-- corresponding style-attributes +attToString :: Attr -> String +attToString ("", classes, kvpairs) = "class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs') + where + kvpairs' = convertToStyle ["width","height","transform"] kvpairs +attToString (id', classes, kvpairs) = "id=\"" <> id' <> "\" class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs') + where + kvpairs' = convertToStyle ["width","height","transform"] kvpairs + +convertToStyle :: [String] -> [(String,String)] -> [(String,String)] +convertToStyle keys kvpairs = ("style", newstyle):rest + where + oldstyle = case filter (\(k,_) -> k == "style") kvpairs of + [(_,st)] -> st + _ -> "" + stylesToAdd = filter (\(k,_) -> k `elem` keys) kvpairs + rest = filter (\(k,_) -> k `notElem` keys) kvpairs + newstyle = concat ((\(k,v) -> k <> ":" <> v <> ";") <$> stylesToAdd) <> oldstyle + +-- | revealjs has some special attributes that has to be +-- passed to the html, but Pandoc only allows +-- @key=value@-attributes, so we have to abuse +-- @.class@ to rewrite them. +-- +-- The classes that get rewritten are listed here. +-- +-- You probably want 'classToRevealAttr', as that +-- is a wrapper for splitting the class-attribute +revealjsSpecialAttrs :: [String] +revealjsSpecialAttrs = + [ "data-markdown" + , "data-timing" + , "data-template" + , "data-autoplay" + , "data-prevent-swipe" + , "data-background-interactive" + , "data-trim" + , "data-noescape" + , "data-ignore" + , "controls" + ] + +-- | revealjs has some special attributes that has to be +-- passed to the html, but Pandoc only allows +-- @key=value@-attributes, so we have to abuse +-- @.class@ to rewrite them. +-- +-- This is a wrapper-function which just splits the list +-- into real classes and 'revealjsSpecialAttrs' +classToRevealAttr :: [String] -> ([String],[String]) +classToRevealAttr = partition (`elem` revealjsSpecialAttrs) + +-- | small wrapper around @RawInline (Format "html")@ +-- as this is less line-noise in the filters and the +-- intent is more clear. +toHtml :: String -> Inline +toHtml = RawInline (Format "html") + + +-- | small wrapper around @Raw (Format "html")@ +-- as this is less line-noise in the filters and the +-- intent is more clear. +toBlockHtml :: String -> Block +toBlockHtml = RawBlock (Format "html") diff --git a/src/Text/Pandoc/Util/Filter/Cols.hs b/src/Text/Pandoc/Util/Filter/Cols.hs new file mode 100644 index 0000000..7f5e2b5 --- /dev/null +++ b/src/Text/Pandoc/Util/Filter/Cols.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Conversion of lvl-x-headings to x-column-layouts in HTML +-- especially for use in revealjs-slides +module Text.Pandoc.Util.Filter.Cols + (cols) + where + +import Text.Pandoc.JSON +import Data.Monoid ((<>)) +import Text.Read (readMaybe) +import Data.Maybe (fromMaybe) +import Text.Pandoc.Util.Filter + +-- | This filter makes multi-column-layouts out of lvl-x-headings +-- +-- Syntax is +-- +-- @ +-- ## a b +-- @ +-- +-- yielding a 2-column-layout with aspects a:b i.e. 1:1 for 50/50-layout +-- or 8:2 for 80/20 layout +-- +-- currently works for 2 and 3-columns, but extension is straight-forward. +-- +-- If you need multiple Block-Elements inside one column, just wrap them +-- with a @\@: +-- +-- @ +-- ## 2 5 +-- +-- \ +-- multiple things +-- ``` +-- foo +-- ``` +-- ![image](...) +-- \ +-- +-- second column here with only 1 element. +-- @ +cols :: [Block] -> [Block] +cols (Header 2 attr [Str wa,Space,Str wb]:a:b:rest) = + outerDiv:rest + where + wa' = fromMaybe 1 (readMaybe wa) :: Int + wb' = fromMaybe 1 (readMaybe wb) :: Int + total = wa' + wb' + pa = (100*wa') `div` total + pb = (100*wb') `div` total + outerDiv = Div attr [ makeDiv pa a + , makeDiv pb b + , clearDiv + ] +cols (Header 3 attr [Str wa,Space,Str wb,Space,Str wc]:a:b:c:rest) = + outerDiv:rest + where + wa' = fromMaybe 1 (readMaybe wa) :: Int + wb' = fromMaybe 1 (readMaybe wb) :: Int + wc' = fromMaybe 1 (readMaybe wc) :: Int + total = wa' + wb' + wc' + pa = (100*wa') `div` total + pb = (100*wb') `div` total + pc = (100*wc') `div` total + outerDiv = Div attr [ makeDiv pa a + , makeDiv pb b + , makeDiv pc c + , clearDiv + ] +cols x = x + +makeDiv :: Int -> Block -> Block +makeDiv width content = Div ("", [], [("style","width:" <> show width <> "%;float:left")]) [content] + +clearDiv :: Block +clearDiv = Div ("", [], [("style", "clear: both")]) [Plain [toHtml " "]] diff --git a/src/Text/Pandoc/Util/Filter/Media.hs b/src/Text/Pandoc/Util/Filter/Media.hs new file mode 100644 index 0000000..0865b8f --- /dev/null +++ b/src/Text/Pandoc/Util/Filter/Media.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Text.Pandoc.Util.Filter.Media + (media) + where + +import Text.Pandoc.JSON +import Control.Exception +import Data.Monoid ((<>)) +import Data.Char (toLower) +import System.FilePath + +import Text.Pandoc.Util.Filter + +{-# ANN module "HLint: ignore Redundant $" #-} -- supress HLint-Warnings about $ + +-- | File-extensions that should be treated as audio +audioExt :: [String] +audioExt = ["mp3","aac"] + +-- | File-extensions that should be treated as video +videoExt :: [String] +videoExt = [ "avi" + , "mp4" + , "mov" + ] + +-- | File-extensions that should be treated as image +imgExt :: [String] +imgExt = + [ "jpg" + , "jpeg" + , "png" + , "gif" + , "tif" + , "tiff" + , "bmp" + , "svg" + ] + +-- | File-extensions that should be treated as demo and will be included +-- in an iframe +demoExt :: [String] +demoExt = ["html", "htm"] + +-- | main media-plugin. +-- +-- Will convert the following syntax +-- +-- @ +-- ![](foo.aac){#audio} +-- ![](foo.mp4){#video} +-- ![](foo.png){#img} +-- ![](foo.svg){#svg} +-- ![](foo.html){#demo} +-- @ +-- +-- HTML-id's maybe ommitted if the file-extension is in whitelist. +-- +-- If a type is detected by extension a custom id (not matching the extension) +-- will be preserved. +-- +media :: Inline -> IO [Inline] +--audio +media (Image (id',att,att') [] (filename,_)) + | id' == "audio" || checkExtension filename audioExt + = return $ [toHtml $ ""] + where + (direct, css) = classToRevealAttr att +media (Image (id',att,att') alt (filename,_)) + | id' == "audio" || checkExtension filename audioExt + = return $ [toHtml $ "
    "] + <> [toHtml $ "
    "] + <> alt + <> [toHtml $ "
    "] + where + (direct, css) = classToRevealAttr att +--videos +media (Image (id', att, att') [] (filename,_)) + | id' == "video" || checkExtension filename videoExt + = return $ [toHtml $ ""] + where + (direct, css) = classToRevealAttr att +media (Image (id', att, att') alt (filename,_)) + | id' == "video" || checkExtension filename videoExt + = return $ [toHtml $ "
    "] + <> [toHtml $ ""] + <> [toHtml $ "
    "] + <> alt + <> [toHtml $ "
    "] + where + (direct, css) = classToRevealAttr att +--images +media (Image (id', att, att') [] (filename,_)) + | id' == "img" || checkExtension filename imgExt + = return $ [toHtml $ "
    "] + <> [toHtml $ " unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> ">"] + <> [toHtml $ "
    "] + where + (direct, css) = classToRevealAttr att +media (Image (id', att, att') alt (filename,_)) + | id' == "img" || checkExtension filename imgExt + = return $ [toHtml $ "
    "] + <> [toHtml $ " unwords direct <> " src=\"" <> filename <> "\"" <> attToString (idFilter "img" id',css,att') <> ">"] + <> [toHtml $ "
    "] + <> alt + <> [toHtml $ "
    "] + where + (direct, css) = classToRevealAttr att +--load svg and dump it in +media (Image (id', att, att') [] (filename,_)) + | id' == "svg" + = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "
    " <> show fileerror]) $ + do + svg <- readFile filename + return $ [toHtml $ "
    unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"] -- use attributes on figure, as svg gets dumped in.. + <> [toHtml $ svg] + <> [toHtml $ "
    "] + where + (direct, css) = classToRevealAttr att +media (Image (id', att, att') alt (filename,_)) + | id' == "svg" + = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "
    " <> show fileerror]) $ + do + svg <- readFile filename + return $ [toHtml $ "
    unwords direct <> " " <> attToString (idFilter "svg" id', css, att') <> ">"] -- use attributes on figure, as svg gets dumped in.. + <> [toHtml $ svg] + <> [toHtml $ "
    "] + <> alt + <> [toHtml $ "
    "] + where + (direct, css) = classToRevealAttr att +--html-demos etc. as IFrames +media (Image (id', att, att') [] (filename,_)) + | id' == "demo" || checkExtension filename demoExt + = return [toHtml $ ""] + where + (direct, css) = classToRevealAttr att +media (Image (id', att, att') alt (filename,_)) + | id' == "demo" || checkExtension filename demoExt + = return $ [toHtml $ "
    "] + <> [toHtml $ ""] + <> [toHtml $ "
    "] + <> alt + <> [toHtml $ "
    "] + where + (direct, css) = classToRevealAttr att +-- if not matched +media x = return [x] + +checkExtension :: String -> [String] -> Bool +checkExtension fn exts = (fmap toLower . tail . takeExtension) fn `elem` exts + +idFilter :: String -> String -> String +idFilter a b + | a == b = "" + | otherwise = b + diff --git a/src/Text/Pandoc/Util/Filter/Quiz.hs b/src/Text/Pandoc/Util/Filter/Quiz.hs new file mode 100644 index 0000000..fb96de9 --- /dev/null +++ b/src/Text/Pandoc/Util/Filter/Quiz.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Text.Pandoc.Util.Filter.Quiz + (quiz) + where + +import Text.Pandoc.JSON +import Text.Pandoc.Walk +import Data.Monoid ((<>)) +import Data.Maybe (isNothing, mapMaybe, listToMaybe) + +-- Move bottom-Up through the structure, find quiz-answers and remove the +-- incorrect formattet ones from the Block they came from. +quiz :: Block -> [Block] +quiz pb@(Plain b) = fmap makeQuiz (query findQuiz pb) <> [Plain (filter ((==) [] . findQuiz) b)] +quiz pb@(Para b) = fmap makeQuiz (query findQuiz pb) <> [Plain (filter ((==) [] . findQuiz) b)] +quiz x = [x] + +-- If we have []{.answer} then we have a quiz-answer +-- maybe with a tooltip +findQuiz :: Inline -> [(Attr, [Inline], Maybe ([Inline],Attr))] +findQuiz (Span attributes@(_, att, _) answerText) + | "answer" `elem` att = [(attributes, answerText', tooltip)] + where + answerText' = filter (isNothing . findTooltip) answerText --filter everything that is a tooltip + tooltip = listToMaybe $ mapMaybe findTooltip answerText --get the first span that is labled tooltip +findQuiz _ = [] + +-- If we have []{.tooltip} we have a tooltip ;) +-- we save the text and the attributes in a tuple +findTooltip :: Inline -> Maybe ([Inline],Attr) +findTooltip (Span attr@(_,att,_) tooltipText) + | "tooltip" `elem` att = Just (tooltipText, attr) +findTooltip _ = Nothing + +-- Generate Divs for the quiz +makeQuiz :: (Attr, [Inline], Maybe ([Inline],Attr)) -> Block +makeQuiz (att, answer, Nothing) = Div att [Plain answer] +makeQuiz (att, answer, Just (tooltip,a)) = Div att [Plain answer, Div a [Plain tooltip]] diff --git a/src/Text/Pandoc/Util/Filter/Styling.hs b/src/Text/Pandoc/Util/Filter/Styling.hs new file mode 100644 index 0000000..09d4c4f --- /dev/null +++ b/src/Text/Pandoc/Util/Filter/Styling.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Text.Pandoc.Util.Filter.Styling + (styling, inlineStyling) + where + +import Text.Pandoc.JSON +import Data.Monoid ((<>)) +import Text.Pandoc.Util.Filter +import Prelude hiding (div, span) + +-- | Block-Styling +-- +-- Special cases captured: +-- +-- - #col turns a div into a floating-div for multiple columns +-- - CodeBlock gets attributes @data-trim@ and @data-noescape@ +-- automatically +-- - .fragment and .frame work properly on divs +styling :: Block -> IO [Block] +styling (Div ("col",att,att') inner) = return $ [toBlockHtml $ "
    unwords direct <> attToString ("",css,att') <> ">"] + ++ inner + ++ [toBlockHtml"
    "] + where + (direct, css) = classToRevealAttr att +styling (CodeBlock (id',att,att') inner) = return + [CodeBlock (id', addToAtt "data-trim" + . addToAtt "data-noescape" + $ att + , att') + inner] +styling div@(Div (id',att,att') inner) + | "fragment" `elem` att = return [Div (id', att, addToStyle "display: block;" att') inner] + | "frame" `elem` att = return [Div (id', addToAtt "fragment" --insert fragment + . addToAtt "current-visible" --insert current-visible + . filter (/= "frame") --remove frame + $ att + , addToStyle "display: block;" att') inner] + | otherwise = return [div] +styling x = return [x] + + +-- | Inline-Styling +-- +-- Special cases captured: +-- +-- - .fragment and .frame work properly on spans +-- - .vspace inside span adds a vertical space with @height=xxx@ +-- - .hspace inside span adds a horizontal space with @width=xxx@ +inlineStyling :: Inline -> Inline +inlineStyling span@(Span (id', att, att') inner) + | "fragment" `elem` att = Span (id', att, addToStyle "display: inline-block;" att') inner + | "frame" `elem` att = Span (id', addToAtt "fragment" --insert fragment + . addToAtt "current-visible" --insert current-visible + . filter (/= "frame") --remove frame + $ att + , addToStyle "display: inline-block;" att') inner + | id' == "vspace" = toHtml $ "
    unwords direct <> attToString ("",css,att') <> ">
    " + | id' == "hspace" = toHtml $ " unwords direct <> attToString ("",css,att') <> ">" + | otherwise = span + where + (direct, css) = classToRevealAttr att +inlineStyling x = x +