Skip to content

GitLab

Commit 281598d5 authored by Mario Botsch's avatar Mario Botsch
Browse files

Merge branch 'master' into mario

parents a1bf666e fae475b2
Hide whitespace changes
Inline Side-by-side
resource/support/plugins/explain/explain.css
View file @ 281598d5
......@@ -81,6 +81,8 @@ div#record-panel {
flex-flow: column-reverse nowrap;
justify-content: center;
font-family: sans-serif;
transform: translate(-50%, var(--offset));
opacity: 0.5;
transition: transform 0.3s ease-in-out 0.5s, opacity 0.3s linear 0.5s,
......@@ -189,6 +191,11 @@ button.stop-button {
flex-grow: 1;
}
span.capture-size {
font-size: 80%;
padding-right: 2em;
}
#explain-panel {
position: fixed;
top: 0;
......
resource/support/plugins/explain/explain.js
View file @ 281598d5
......@@ -17,6 +17,7 @@ let ExplainPlugin = (function () {
let volumeMeter;
let micSelect, camSelect;
let micIndicator, camIndicator;
let screenCaptureSize, cameraCaptureSize;
// playback stuff
let explainVideoUrl, explainTimesUrl, explainTimes;
......@@ -265,11 +266,10 @@ let ExplainPlugin = (function () {
}
async function captureScreen() {
const config = Reveal.getConfig().explain;
const recWidth =
config && config.recWidth ? config.recWidth : Reveal.getConfig().width;
const recHeight =
config && config.recHeight ? config.recHeight : Reveal.getConfig().height;
// const config = Reveal.getConfig().explain;
const config = Decker.meta.explain;
const recWidth = config && config.recWidth ? config.recWidth : undefined;
const recHeight = config && config.recHeight ? config.recHeight : undefined;
// get display stream
console.log("get display stream (" + recWidth + "x" + recHeight + ")");
......@@ -284,6 +284,10 @@ let ExplainPlugin = (function () {
audio: true,
});
let video = desktopStream.getVideoTracks()[0].getSettings();
console.log("display stream size: ", video.width, video.height);
screenCaptureSize.textContent = `${video.width}x${video.height}`;
if (desktopStream.getAudioTracks().length > 0) {
let label = desktopStream.getAudioTracks()[0].label;
desktopIndicator.title = label;
......@@ -337,9 +341,10 @@ let ExplainPlugin = (function () {
}
async function captureCamera() {
const config = Reveal.getConfig().explain;
const camWidth = config && config.camWidth ? config.camWidth : 1280;
const camHeight = config && config.camHeight ? config.camHeight : 720;
// const config = Reveal.getConfig().explain;
const config = Decker.meta.explain;
const camWidth = config && config.camWidth ? config.camWidth : undefined;
const camHeight = config && config.camHeight ? config.camHeight : undefined;
console.log("get camera stream (" + camWidth + "x" + camHeight + ")");
console.log("cam id: " + camSelect.value);
......@@ -374,6 +379,9 @@ let ExplainPlugin = (function () {
} else {
cameraVideo.srcObject = cameraStream;
}
let camera = cameraStream.getVideoTracks()[0].getSettings();
console.log("camera stream size: ", camera.width, camera.height);
cameraCaptureSize.textContent = `${camera.width}x${camera.height}`;
} else {
camIndicator.removeAttribute("title");
}
......@@ -868,6 +876,38 @@ let ExplainPlugin = (function () {
});
camSelect.onchange = captureCamera;
row = createElement({
type: "div",
classes: "controls-row",
parent: recordPanel,
});
createElement({
type: "i",
classes: "indicator fas fa-camera",
title: "Camera capture size",
parent: row,
});
cameraCaptureSize = createElement({
type: "span",
classes: "capture-size",
parent: row,
});
createElement({
type: "i",
classes: "indicator fas fa-tv",
title: "Screen capture size",
parent: row,
});
screenCaptureSize = createElement({
type: "span",
classes: "capture-size",
parent: row,
});
// collect list of cameras and microphones
try {
const devices = await navigator.mediaDevices.enumerateDevices();
......@@ -1152,7 +1192,8 @@ let ExplainPlugin = (function () {
}
async function setupPlayer() {
let config = Reveal.getConfig().explain;
// const config = Reveal.getConfig().explain;
const config = Decker.meta.explain;
explainVideoUrl = config && config.video ? config.video : deckVideoUrl();
explainTimesUrl = config && config.times ? config.times : deckTimesUrl();
......@@ -1237,8 +1278,8 @@ let ExplainPlugin = (function () {
});
// Try to connect to an existing video.
uiState.transition("setupPlayer");
addReloadInhibitor(() =>
!uiState.in("RECORDER_READY", "RECORDER_PAUSED", "RECORDING")
addReloadInhibitor(
() => !uiState.in("RECORDER_READY", "RECORDER_PAUSED", "RECORDING")
);
},
};
......
resource/template/deck.html
View file @ 281598d5
......@@ -15,7 +15,7 @@ $if(keywords)$
$endif$
<meta name="apple-mobile-web-app-capable" content="yes">
$if(template.favicon)$
<link rel="shortcut icon" href="$template.favicon$">
<link rel="icon" type="image/png" href="$template.favicon$">
$endif$
$if(mario)$
$if(title)$
......@@ -130,6 +130,12 @@ $endif$
$for(template.css)$
<link rel="stylesheet" href="$template.css$"/>
$endfor$
<script>
/* Store JSON encoded Pandoc meta data in a global variable for easy
reference from any script. */
window.Decker = {meta: $decker-meta$};
</script>
<!-- Printing and PDF exports -->
<script>
var link = document.createElement( 'link' );
......@@ -332,9 +338,7 @@ $endfor$
pdfMaxPagesPerSlide: 10,
pdfSeparateFragments: false,
// Display controls in the bottom right corner
$if(controls)$
controls: $controls$,
$endif$
controls: Decker.meta.controls,
// Display a presentation progress bar
$if(progress)$
progress: $progress$,
......@@ -597,7 +601,6 @@ $else$
$endif$
},
// setup charts
chart: {
defaults: {
......@@ -630,26 +633,11 @@ $if(thebelab.enable)$
thebelab: $thebelab.enable$,
$endif$
$if(quizServer)$
// Mario's multiple-choice quiz
quiz: { server: "$quizServer$" },
$endif$
$if(explain)$
explain: {
$if(explain.video)$ video: "$explain.video$", $endif$
$if(explain.times)$ times: "$explain.times$", $endif$
$if(explain.recWidth)$ recWidth: "$explain.recWidth$", $endif$
$if(explain.recHeight)$ recHeight: "$explain.recHeight$", $endif$
$if(explain.camWidth)$ camWidth: "$explain.camWidth$", $endif$
$if(explain.camHeight)$ camHeight: "$explain.camHeight$", $endif$
dummy: "dummy"
},
$endif$
// plugins
dependencies: [
{ src: String.raw`$decker-support-dir$/plugins/charts/Chart.js`},
......
src/Text/Decker/Filter/Macro.hs
View file @ 281598d5
{-# LANGUAGE OverloadedStrings #-}
module Text.Decker.Filter.Macro
( expandDeckerMacros
, embedWebVideosHtml
) where
import Text.Decker.Internal.Common
import Text.Decker.Internal.Meta
module Text.Decker.Filter.Macro
( expandDeckerMacros,
embedWebVideosHtml,
)
where
import Control.Monad.State
import Data.List (find, intersperse)
......@@ -15,10 +14,12 @@ import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import Text.Blaze (customAttribute)
import Text.Blaze.Html.Renderer.Text
import Text.Blaze.Html5 as H ((!), div, figure, iframe, iframe, p, toValue)
import Text.Blaze.Html5 as H (div, figure, iframe, p, toValue, (!))
import Text.Blaze.Html5.Attributes as A (class_, height, src, style, width)
import Text.Decker.Internal.Common
import Text.Decker.Internal.Meta
import Text.Pandoc hiding (lookupMeta)
import Text.Pandoc.Shared hiding (lookupMeta)
import Text.Pandoc.Shared hiding (lookupMeta)
import Text.Pandoc.Walk
import Text.Printf
import Text.Read
......@@ -53,12 +54,14 @@ embedWebVideosHtml page args attr@(_, _, kv) (vid, _) =
printf
"https://www.youtube.com/embed/%s?iv_load_policy=3&disablekb=1&rel=0&modestbranding=1&autohide=1&start=%s"
vid
start :: String
start ::
String
"vimeo" ->
printf
"https://player.vimeo.com/video/%s?quality=autop&muted=0#t=%s"
vid
start :: String
start ::
String
"twitch" ->
printf "https://player.twitch.tv/?channel=%s&autoplay=1&muted=1" vid :: String
"veer" ->
......@@ -66,7 +69,8 @@ embedWebVideosHtml page args attr@(_, _, kv) (vid, _) =
"veer-photo" ->
printf
"https://h5.veer.tv/photo-player?pid=%s&amp;utm_medium=embed"
vid :: String
vid ::
String
_ -> error $ "Unknown streaming service: " <> toString vid
vidWidthStr = macroArg 0 args "560"
vidHeightStr = macroArg 1 args "315"
......@@ -75,23 +79,24 @@ embedWebVideosHtml page args attr@(_, _, kv) (vid, _) =
wrapperStyle =
printf
"position:relative;padding-top:25px;padding-bottom:%f%%;height:0;"
(vidHeight / vidWidth * 100.0) :: String
(vidHeight / vidWidth * 100.0) ::
String
iframeStyle =
"position:absolute;top:0;left:0;width:100%;height:100%;" :: String
figureStyle (_, _, kv) =
foldl (\s (k, v) -> s ++ printf "%s:%s;" k v :: String) "" kv
figureClass (_, cls, _) = Text.unwords cls
html =
H.figure ! class_ (toValueT (figureClass attr)) !
style (toValue (figureStyle attr)) $
H.div ! style (toValue wrapperStyle) $
iframe ! style (toValue iframeStyle) ! width (toValue vidWidthStr) !
height (toValue vidHeightStr) !
src (toValue url) !
customAttribute "frameborder" "0" !
auto !
customAttribute "allowfullscreen" "" $
H.p ""
H.figure ! class_ (toValueT (figureClass attr))
! style (toValue (figureStyle attr))
$ H.div ! style (toValue wrapperStyle) $
iframe ! style (toValue iframeStyle) ! width (toValue vidWidthStr)
! height (toValue vidHeightStr)
! src (toValue url)
! customAttribute "frameborder" "0"
! auto
! customAttribute "allowfullscreen" ""
$ H.p ""
auto =
if (autoplay == "1" || autoplay == "true")
then (customAttribute "data-autoplay" "")
......@@ -100,13 +105,23 @@ embedWebVideosHtml page args attr@(_, _, kv) (vid, _) =
toValueT = toValue . Text.unpack
fontAwesome :: Text.Text -> MacroAction
fontAwesome which _ _ (iconName, _) _ = do
fontAwesome which _ (_, cls, kvs) (iconName, _) _ = do
let classes = Text.intercalate " " (which : cls)
let style = fromMaybe "" $ lookup "style" kvs
disp <- gets disposition
case disp of
Disposition _ Html ->
return $
RawInline (Format "html") $
Text.concat ["<i class=\"", which, " fa-", iconName, "\"></i>"]
RawInline (Format "html") $
Text.concat
[ "<i class=\"",
classes,
" fa-",
iconName,
"\" style=\"",
style,
"\"></i>"
]
Disposition _ _ -> return $ Str $ "[" <> iconName <> "]"
horizontalSpace :: MacroAction
......@@ -115,9 +130,9 @@ horizontalSpace _ _ (space, _) _ = do
case disp of
Disposition _ Html ->
return $
RawInline (Format "html") $
Text.pack $
printf "<span style=\"display:inline-block; width:%s;\"></span>" space
RawInline (Format "html") $
Text.pack $
printf "<span style=\"display:inline-block; width:%s;\"></span>" space
Disposition _ _ -> return $ Str $ "[" <> space <> "]"
verticalSpace :: MacroAction
......@@ -126,9 +141,9 @@ verticalSpace _ _ (space, _) _ = do
case disp of
Disposition _ Html ->
return $
RawInline (Format "html") $
Text.pack $
printf "<div style=\"display:block; clear:both; height:%s;\"></div>" space
RawInline (Format "html") $
Text.pack $
printf "<div style=\"display:block; clear:both; height:%s;\"></div>" space
Disposition _ _ -> return $ Str $ "[" <> space <> "]"
metaMacro :: MacroAction
......@@ -150,13 +165,13 @@ type MacroMap = Map.Map Text.Text MacroAction
macroMap :: MacroMap
macroMap =
Map.fromList
[ ("meta", metaMacro)
, ("fa", fontAwesome "fas")
, ("fas", fontAwesome "fas")
, ("far", fontAwesome "far")
, ("fab", fontAwesome "fab")
, ("hspace", horizontalSpace)
, ("vspace", verticalSpace)
[ ("meta", metaMacro),
("fa", fontAwesome "fas"),
("fas", fontAwesome "fas"),
("far", fontAwesome "far"),
("fab", fontAwesome "fab"),
("hspace", horizontalSpace),
("vspace", verticalSpace)
]
readDefault :: Read a => a -> Text.Text -> a
......@@ -176,20 +191,20 @@ parseMacro invocation = Text.words <$> Text.stripPrefix ":" invocation
expandInlineMacros :: Meta -> Inline -> Decker Inline
expandInlineMacros meta inline@(Link attr text target) =
case parseMacro $ stringify text of
Just (name:args) ->
Just (name : args) ->
case Map.lookup name macroMap of
Just macro -> macro args attr target meta
Nothing -> return inline
_ -> return inline
expandInlineMacros meta inline@(Image attr _ (url, tit))
expandInlineMacros meta inline@(Image attr _ (url, tit)) =
-- For the case of web videos
=
case findEmbeddingType inline of
Just str ->
case Map.lookup str macroMap of
Just macro -> macro [] attr (code, tit) meta
-- TODO: Find a way to do this without needing Data.Text and the whole pack/unpack effort
where code = Text.replace (str <> "://") "" url
where
-- TODO: Find a way to do this without needing Data.Text and the whole pack/unpack effort
code = Text.replace (str <> "://") "" url
Nothing -> return inline
Nothing -> return inline
expandInlineMacros _ inline = return inline
......
src/Text/Decker/Internal/External.hs
View file @ 281598d5
......@@ -49,7 +49,8 @@ programs =
"--perms",
"--chmod=a+r,go-w",
"--no-owner",
"--copy-links"
"--copy-links",
"--delete"
]
["--version"]
(helpText "`rsync` (https://rsync.samba.org)")
......
src/Text/Decker/Internal/Meta.hs
View file @ 281598d5
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Text.Decker.Internal.Meta
( DeckerException(..)
, FromMetaValue(..)
, addMetaValue
, globalMetaFileName
, mergePandocMeta'
, pandocMeta
, setMetaValue
, adjustMetaValue
, adjustMetaValueM
, adjustMetaStringsBelow
, adjustMetaStringsBelowM
, toPandocMeta
, toPandocMeta'
, lookupMeta
, lookupMetaOrElse
, lookupMetaOrFail
, lookupInDictionary
, mapMeta
, mapMetaM
, mapMetaValues
, mapMetaValuesM
, mapMetaWithKey
, readMetaDataFile
) where
( DeckerException (..),
FromMetaValue (..),
addMetaValue,
globalMetaFileName,
mergePandocMeta',
pandocMeta,
setMetaValue,
adjustMetaValue,
adjustMetaValueM,
adjustMetaStringsBelow,
adjustMetaStringsBelowM,
toPandocMeta,
toPandocMeta',
lookupMeta,
lookupMetaOrElse,
lookupMetaOrFail,
lookupInDictionary,
mapMeta,
mapMetaM,
mapMetaValues,
mapMetaValuesM,
mapMetaWithKey,
readMetaDataFile,
embedMetaMeta,
)
where
import Control.Exception
import qualified Data.Aeson as A
import qualified Data.HashMap.Strict as H
import qualified Data.List as List
import Data.List.Safe ((!!))
import qualified Data.Map.Lazy as Map
import qualified Data.Map.Strict as M
......@@ -41,9 +44,7 @@ import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Vector as Vec
import qualified Data.Yaml as Y
import Relude
import Text.Decker.Internal.Exception
import Text.Pandoc hiding (lookupMeta)
import Text.Pandoc.Builder hiding (fromList, lookupMeta, toList)
......@@ -85,7 +86,18 @@ toPandocMeta' (Y.Number scientific) = MetaString $ Text.pack $ show scientific
toPandocMeta' (Y.Bool bool) = MetaBool bool
toPandocMeta' Y.Null = MetaList []
-- | Split a compound meta key at the dots and separate the array indexes.
fromPandocMeta :: Meta -> A.Value
fromPandocMeta (Meta map) = fromPandocMeta' (MetaMap map)
fromPandocMeta' :: MetaValue -> A.Value
fromPandocMeta' (MetaMap map) = A.Object (H.fromList $ Map.toList $ Map.map fromPandocMeta' map)
fromPandocMeta' (MetaList list) = A.Array (Vec.fromList $ List.map fromPandocMeta' list)
fromPandocMeta' (MetaBool value) = A.Bool value
fromPandocMeta' (MetaString value) = A.String value
fromPandocMeta' (MetaInlines value) = A.String (stringify value)
fromPandocMeta' (MetaBlocks value) = A.Null
-- |  Split a compound meta key at the dots and separate the array indexes.
splitKey = concatMap splitIndex . Text.splitOn "."
where
splitIndex key =
......@@ -100,25 +112,25 @@ splitKey = concatMap splitIndex . Text.splitOn "."
getMetaValue :: Text -> Meta -> Maybe MetaValue
getMetaValue key meta = lookup' (splitKey key) (MetaMap (unMeta meta))
where
lookup' (key:path) (MetaMap map) = M.lookup key map >>= lookup' path
lookup' (key:path) (MetaList list) =
lookup' (key : path) (MetaMap map) = M.lookup key map >>= lookup' path
lookup' (key : path) (MetaList list) =
(readMaybe . Text.unpack) key >>= (!!) list >>= lookup' path
lookup' (_:_) _ = Nothing
lookup' (_ : _) _ = Nothing
lookup' [] mv = Just mv
-- | Sets a meta value at the compound key in the meta data. If any intermediate
-- containers do not exist, they are created.
-- containers do not exist, they are created.
setMetaValue :: ToMetaValue a => Text -> a -> Meta -> Meta
setMetaValue key value meta = Meta $ set (splitKey key) (MetaMap (unMeta meta))
where
set [k] (MetaMap map) = M.insert k (toMetaValue value) map
set (k:p) (MetaMap map) =
set (k : p) (MetaMap map) =
case M.lookup k map of
Just value -> M.insert k (MetaMap $ set p value) map
_ -> M.insert k (MetaMap $ set p $ MetaMap M.empty) map
set _ _ =
throw $
InternalException $ "Cannot set meta value on non object at: " <> show key
InternalException $ "Cannot set meta value on non object at: " <> show key
-- | Recursively deconstruct a compound key and drill into the meta data hierarchy.
-- Apply the function to the value if the key exists.
......@@ -128,19 +140,19 @@ adjustMetaValue f key meta =
where
adjust :: [Text] -> MetaValue -> Map Text MetaValue
adjust [k] (MetaMap map) = M.adjust f k map
adjust (k:p) (MetaMap map) =
adjust (k : p) (MetaMap map) =
case M.lookup k map of
Just value -> M.insert k (MetaMap $ adjust p value) map
_ -> map
adjust _ _ =
throw $
InternalException $
"Cannot adjust meta value on non object at: " <> show key
InternalException $
"Cannot adjust meta value on non object at: " <> show key
-- | Recursively deconstruct a compound key and drill into the meta data hierarchy.
-- Apply the IO action to the value if the key exists.
adjustMetaValueM ::
Monad m => (MetaValue -> m MetaValue) -> Text -> Meta -> m Meta
Monad m => (MetaValue -> m MetaValue) -> Text -> Meta -> m Meta
adjustMetaValueM action key meta =
Meta <$> adjust (splitKey key) (MetaMap (unMeta meta))
where
......@@ -150,7 +162,7 @@ adjustMetaValueM action key meta =
v' <- action v
return $ M.insert k v' map
_ -> return map
adjust (k:p) (MetaMap map) =
adjust (k : p) (MetaMap map) =
case M.lookup k map of
Just value -> do
m' <- adjust p value
......@@ -158,8 +170,8 @@ adjustMetaValueM action key meta =
_ -> return map
adjust _ _ =
throw $
InternalException $
"Cannot adjust meta value on non object at: " <> show key
InternalException $
"Cannot adjust meta value on non object at: " <> show key
-- | Recursively traverse all meta values below the compound key that can be
-- stringified and transform them by the supplied function.
......@@ -169,11 +181,11 @@ adjustMetaStringsBelow func = adjustMetaValue (mapMetaValues func)
-- | Recursively traverse all meta values below the compound key that can be
-- stringified and transform them by the supplied action.
adjustMetaStringsBelowM ::
(MonadFail m, Monad m) => (Text -> m Text) -> Text -> Meta -> m Meta
(MonadFail m, Monad m) => (Text -> m Text) -> Text -> Meta -> m Meta
adjustMetaStringsBelowM action = adjustMetaValueM (mapMetaValuesM action)
-- | Adds a meta value to the list found at the compund key in the meta data.
-- If any intermediate containers do not exist, they are created.
-- If any intermediate containers do not exist, they are created.
addMetaValue :: ToMetaValue a => Text -> a -> Meta -> Meta
addMetaValue key value meta =
case add (splitKey key) (MetaMap (unMeta meta)) of
......@@ -185,14 +197,14 @@ addMetaValue key value meta =
case M.lookup k m of
Just value -> MetaMap $ M.insert k (add [] value) m
_ -> MetaMap $ M.insert k (add [] $ MetaList []) m
add (k:p) (MetaMap m) =
add (k : p) (MetaMap m) =
case M.lookup k m of
Just value -> MetaMap $ M.insert k (add p value) m
_ -> MetaMap $ M.insert k (add p $ MetaMap M.empty) m
add _ _ =
throw $
InternalException $
"Cannot add meta value to non list at: " <> toString key
InternalException $
"Cannot add meta value to non list at: " <> toString key
pandocMeta :: (Text -> Meta -> Maybe a) -> Pandoc -> Text -> Maybe a
pandocMeta f (Pandoc m _) = flip f m
......@@ -229,16 +241,20 @@ instance (Ord a, FromMetaValue a) => FromMetaValue (Set a) where
fromMetaValue (MetaList list) = Just $ fromList $ mapMaybe fromMetaValue list
fromMetaValue _ = Nothing