Commit ff8e6427 authored by Henrik Tramberend's avatar Henrik Tramberend
Browse files

Lazy load images and local movies in image tags.

parent a15573a0
......@@ -4,7 +4,6 @@ date: '15.5.2016'
history: True
signs: © €
subtitle: Tutorial and Examples
theme: 'htr-slides'
title: Decker Slide Tool
transition: linear
ümläüte: Ümläüte
......@@ -63,7 +62,7 @@ The following text is included from file `/resource/realtive.md`:
## The author
![](img/htr-beuth.jpg){.copy width="50%"}![](https://tramberend.beuth-hochschule.de/img/htr-beuth.jpg){.copy width="50%"}
![](img/htr-beuth.jpg){width="50%"}
[Deck markdown source](example-deck.md)
......
......@@ -2,7 +2,8 @@
{-# LANGUAGE OverloadedStrings #-}
module Filter
( expandMacros
( Disposition(..)
, expandMacros
, makeSlides
, filterNotes
, makeBoxes
......@@ -11,11 +12,14 @@ module Filter
, cachePandocImages
, extractLocalImagePathes
, renderImageVideo
, transformImageSize
, lazyLoadImage
, isMacro
) where
import qualified Data.ByteString.Lazy.Char8 as L8
import Data.Default ()
import Data.List
import Data.List.Split
import qualified Data.Map as Map (Map, fromList, lookup)
import Data.Maybe
......@@ -29,7 +33,8 @@ import System.FilePath.Posix
import Text.Blaze (customAttribute)
import Text.Blaze.Html.Renderer.String
import Text.Blaze.Html5 as H
((!), div, figure, iframe, p, source, stringTag, toValue, video)
((!), div, figure, iframe, img, p, source, stringTag, toValue,
video)
import Text.Blaze.Html5.Attributes as A
(alt, class_, height, id, src, style, title, width)
import Text.Pandoc.Definition ()
......@@ -336,20 +341,74 @@ cacheImageIO uri cacheDir = do
videoExtensions =
[".mp4", ".webm", ".ogg", ".avi", ".dv", ".mp2", ".mov", ".qt"]
data Disposition
= Deck
| Page
| Handout
deriving (Eq)
-- Renders an image with a video reference to a video tag in raw HTML. Faithfully
-- transfers attributes to the video tag.
renderImageVideo :: Inline -> IO Inline
renderImageVideo image@(Image (ident, cls, values) inlines (url, tit)) =
if takeExtension url `elem` videoExtensions
then return $ RawInline (Format "html") (renderHtml videoTag)
else return image
renderImageVideo :: Disposition -> Inline -> IO Inline
renderImageVideo disposition image@(Image (ident, cls, values) inlines (url, tit)) =
return $ RawInline (Format "html") (renderHtml $ mediaTag which)
where
which =
if takeExtension url `elem` videoExtensions
then video ""
else img
appendAttr element (key, value) =
element ! customAttribute (stringTag key) (toValue value)
videoTag =
foldl appendAttr video values ! A.id (toValue ident) !
class_ (toValue $ unwords cls) !
alt (toValue $ stringify inlines) !
title (toValue tit) $
source ! src (toValue url)
renderImageVideo inline = return inline
mediaTag tag =
ifNotEmpty A.id ident $
ifNotEmpty class_ (unwords cls) $
ifNotEmpty alt (stringify inlines) $
ifNotEmpty title tit $ foldl appendAttr tag transformedValues
ifNotEmpty attr value element =
if value == ""
then element
else element ! attr (toValue value)
srcAttr =
if disposition == Deck
then "data-src"
else "src"
transformedValues = (lazyLoad . transformImageSize) values
lazyLoad vs = (srcAttr, url) : vs
renderImageVideo _ inline = return inline
-- | Mimic pandoc for handling the 'width' and 'height' attributes of images.
-- That is, transfer 'width' and 'height' attribute values to css style values
-- and add them to the 'style' attribute value.
transformImageSize :: [(String, String)] -> [(String, String)]
transformImageSize attributes =
let style :: [String]
style =
delete "" $
split (dropDelims $ oneOf ";") $
fromMaybe "" $ snd <$> find (\(k, _) -> k == "style") attributes
unstyled :: [(String, String)]
unstyled = filter (\(k, v) -> k /= "style") attributes
unsized =
filter (\(k, v) -> k /= "width") $
filter (\(k, v) -> k /= "height") unstyled
size =
( snd <$> find (\(k, _) -> k == "width") unstyled
, snd <$> find (\(k, _) -> k == "height") unstyled)
sizeStyle =
case size of
(Just w, Just h) -> ["width:" ++ w, "height:" ++ h]
(Just w, Nothing) -> ["width:" ++ w, "height:auto"]
(Nothing, Just h) -> ["width:auto", "height:" ++ h]
(Nothing, Nothing) -> []
css = style ++ sizeStyle
styleAttr = ("style", intercalate ";" $ reverse $ "" : css)
in if null css
then unstyled
else styleAttr : unsized
-- | Moves the `src` attribute to `data-src` to enable reveal.js lazy loading.
lazyLoadImage :: Inline -> IO Inline
lazyLoadImage (Image (ident, cls, values) inlines (url, tit)) = do
let kvs = ("data-src", url) : [kv | kv <- values, "data-src" /= fst kv]
return (Image (ident, cls, kvs) inlines ("", tit))
lazyLoadImage inline = return inline
......@@ -289,7 +289,7 @@ markdownToHtmlDeck markdownFile out = do
]
, writerCiteMethod = Citeproc
}
pandoc <- readAndPreprocessMarkdown markdownFile
pandoc <- readAndPreprocessMarkdown markdownFile Deck
processed <- processPandocDeck "revealjs" pandoc
writePandocString "revealjs" options out processed
......@@ -304,21 +304,28 @@ getPandocWriter format =
-- | Reads a markdownfile, expands the included files, and substitutes mustache
-- template variables and calls need.
readAndPreprocessMarkdown :: FilePath -> Action Pandoc
readAndPreprocessMarkdown markdownFile = do
readAndPreprocessMarkdown :: FilePath -> Disposition -> Action Pandoc
readAndPreprocessMarkdown markdownFile disposition = do
putLoud $ "reading: " ++ markdownFile
dirs <- getProjectDirs
let baseDir = takeDirectory markdownFile
pandoc@(Pandoc meta bocks) <-
pandoc@(Pandoc meta _) <-
readMetaMarkdown markdownFile >>= processIncludes dirs baseDir
let method = provisioningFromMeta meta
let lazy = lookupBool "lazy" False meta
liftIO $
mapMetaResources (provisionMetaResource method dirs baseDir) pandoc >>=
mapResources (provisionExistingResource method dirs baseDir) >>=
walkM renderImageVideo
walkM (renderImageVideo disposition)
-- Disable automatic caching of remote images for a while
-- >>= walkM (cacheRemoteImages (cache dirs))
lookupBool :: String -> Bool -> Meta -> Bool
lookupBool key def meta =
case lookupMeta key meta of
Just (MetaBool b) -> b
_ -> def
provisionMetaResource ::
Provisioning
-> ProjectDirs
......@@ -351,7 +358,7 @@ markdownToHtmlPage markdownFile out = do
, writerVariables = [("decker-support-dir", supportDir)]
, writerCiteMethod = Citeproc
}
pandoc <- readAndPreprocessMarkdown markdownFile
pandoc <- readAndPreprocessMarkdown markdownFile Page
processed <- processPandocPage "html5" pandoc
writePandocString "html5" options out processed
......@@ -366,7 +373,7 @@ markdownToPdfPage markdownFile out = do
-- , writerHighlightStyle = pygments
, writerCiteMethod = Citeproc
}
pandoc <- readAndPreprocessMarkdown markdownFile
pandoc <- readAndPreprocessMarkdown markdownFile Page
processed <- processPandocPage "latex" pandoc
putNormal $ "# pandoc (for " ++ out ++ ")"
pandocMakePdf options processed out
......@@ -380,7 +387,7 @@ pandocMakePdf options processed out = do
-- | Write a markdown file to a HTML file using the handout template.
markdownToHtmlHandout :: FilePath -> FilePath -> Action ()
markdownToHtmlHandout markdownFile out = do
pandoc <- readAndPreprocessMarkdown markdownFile
pandoc <- readAndPreprocessMarkdown markdownFile Handout
processed <- processPandocHandout "html" pandoc
supportDir <- getRelativeSupportDir out
let options =
......@@ -399,7 +406,7 @@ markdownToHtmlHandout markdownFile out = do
-- | Write a markdown file to a PDF file using the handout template.
markdownToPdfHandout :: FilePath -> FilePath -> Action ()
markdownToPdfHandout markdownFile out = do
pandoc <- readAndPreprocessMarkdown markdownFile
pandoc <- readAndPreprocessMarkdown markdownFile Handout
processed <- processPandocHandout "latex" pandoc
let options =
pandocWriterOpts
......
......@@ -9,6 +9,7 @@ import Data.Maybe
import Data.Text
import Data.Text.Encoding
import qualified Data.Yaml as Y
import Filter
import Project as P
import qualified System.Directory as Dir
import System.FilePath
......@@ -60,7 +61,7 @@ main = do
"cache/b48cadafb942dc1426316772321dd0c7.png"
--
describe "removeCommonPrefix" $
it "Removes the common prefix from two pathes." $ do
it "removes the common prefix from two pathes." $ do
P.removeCommonPrefix ("", "") `shouldBe` ("", "")
P.removeCommonPrefix ("fasel/bla", "fasel/bla/lall") `shouldBe`
("", "lall")
......@@ -72,7 +73,7 @@ main = do
("lurgel/hopp", "fasel/bla/lall")
--
describe "resolveLocally" $
it "Resolves a file path to a concrete verified file system path." $ do
it "resolves a file path to a concrete verified file system path." $ do
(resolveLocally
dirs
((project dirs) </> "resource/example")
......@@ -91,7 +92,7 @@ main = do
--
describe "copyResource" $
it
"Copies an existing resource to the public dir and returns the public URL." $ do
"copies an existing resource to the public dir and returns the public URL." $ do
Dir.doesFileExist
((project dirs) </> "resource/example/img/06-metal.png") `shouldReturn`
True
......@@ -107,7 +108,7 @@ main = do
--
describe "linkResource" $
it
"Links an existing resource to the public dir and returns the public URL." $ do
"links an existing resource to the public dir and returns the public URL." $ do
Dir.doesFileExist
((project dirs) </> "resource/example/img/06-metal.png") `shouldReturn`
True
......@@ -122,7 +123,7 @@ main = do
True
--
describe "provisionResource" $ do
it "Copies a presentation time resource into the public dir." $ do
it "copies a presentation time resource into the public dir." $ do
provisionResource
Copy
dirs
......@@ -132,7 +133,7 @@ main = do
Dir.doesFileExist
((public dirs) </> "resource/example/img/06-metal.png") `shouldReturn`
True
it "Links a presentation time resource into the public dir." $ do
it "links a presentation time resource into the public dir." $ do
provisionResource
SymLink
dirs
......@@ -145,7 +146,7 @@ main = do
Dir.pathIsSymbolicLink
((public dirs) </> "resource/example/img/06-metal.png") `shouldReturn`
True
it "Throws, if the resource can not be found." $ do
it "throws, if the resource can not be found." $ do
provisionResource
Copy
dirs
......@@ -154,22 +155,32 @@ main = do
anyException
--
describe "findFile" $ do
it "Finds local file system resources that sre needed at compile time." $
it "finds local file system resources that sre needed at compile time." $
findFile dirs (project dirs) "resource/template/deck.html" `shouldReturn`
project dirs </>
"resource/template/deck.html"
it "Throws, if the resource can not be found." $ do
it "throws, if the resource can not be found." $ do
findFile dirs (project dirs) "deck.html" `shouldThrow` anyException
--
describe "readResource" $ do
it
"Finds local file system or built-in resources that sre needed at compile time." $ do
"finds local file system or built-in resources that sre needed at compile time." $ do
readResource dirs (project dirs </> "resource/template") "deck.html" `shouldReturn`
deckTemplate
readResource dirs (project dirs) "deck.html" `shouldReturn` deckTemplate
it "Throws, if the resource can not be read." $ do
it "throws, if the resource can not be read." $ do
readResource dirs (project dirs) "dreck.html" `shouldThrow` anyException
--
describe "transformImageSize" $
it
"transfers 'width' and 'height' attribute values to css style values and add them to the 'style' attribute value." $ do
transformImageSize [("width", "100%")] `shouldBe`
[("style", "width:100%;")]
transformImageSize [("height", "50%")] `shouldBe`
[("style", "height:50%;")]
transformImageSize [("width", "100%"), ("style", "color:red;")] `shouldBe`
[("style", "width:100%;color:red;")]
{--
describe "cacheRemoteFile" $
it
"Stores the data behind a URL locally, if possible. Return the local path to the cached file." $ do
......@@ -211,3 +222,4 @@ main = do
(cache dirs </> "bc137c359488beadbb61589f7fe9e208.jpg", "")
]
]
--}
......@@ -5,6 +5,6 @@ csl: 'acm-sig-proceedings.csl'
# Citation
Not quite recently published: [@tramberend2003]
Not quite recently published [@tramberend2003]. The bibliography is append at the end of the deck.
## Bibliography
div.slides {background-color: #555;}
\ No newline at end of file
div.slides {background-color: #ddd;}
\ No newline at end of file
[:include](include/something.md)
\ No newline at end of file
[:include](include/something.md)
......@@ -4,4 +4,4 @@
Inclusion is supposed to be transitive with respect to resolution of relative resource and include pathes.
![A simple metal material (Image taken from [CGG](https://tramberend.beuth-hochschule.de/course/sommer-2017/cgg/)).](06-metal.png)
![A simple metal material (Image taken from [CGG](https://tramberend.beuth-hochschule.de/course/sommer-2017/cgg/)).](06-metal.png){width="50%"}
---
history: True
title: Image Handling
---
# Local Image
![](include/06-metal.png)
# Local Image 50%
![](include/06-metal.png){width="50%"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video 50%
![](movie.mp4){width="50%" controls="1" loop="1"}
# Local Video 100px
![](movie.mp4){height="100px" controls="1" loop="1"}
# Local Video 200px x 200px
![](movie.mp4){width="200px" height="200px" controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}
# Local Video
![](movie.mp4){controls="1" loop="1"}