Source file slipshow.ml

module Asset = Asset
module Frontmatter = Frontmatter

type file_reader = Fpath.t -> (string option, [ `Msg of string ]) result

let math_option_elem math_mode ~has_math =
  let elem =
    if not has_math then ""
    else
      match math_mode with
      | `Katex ->
          {| window.Katex = {
          // customised options
          // • auto-render specific keys, e.g.:
          delimiters: [
              {left: '\\(', right: '\\)', display: false},
              {left: '\\[', right: '\\]', display: true}
          ],
          // • rendering keys, e.g.:
            throwOnError : false,
            strict: false,
            trust:true
        };
|}
      | `Mathjax ->
          {|window.MathJax = {
  loader: {load: ['[tex]/html']},
  tex: {packages: {'[+]': ['html']}}
};|}
  in
  "<script>" ^ elem ^ "</script>"

let mermaid_option_elem ~has_mermaid =
  let elem =
    if not has_mermaid then ""
    else
      {|window.Mermaid = { startOnLoad: false, deterministicIds : true, securityLevel: "loose" };|}
  in
  "<script>" ^ elem ^ "</script>"

let mathjax_element math_mode has_math math_link =
  if not has_math then ""
  else
    match math_link with
    | Some (Asset.Local { content = t; _ }) ->
        Format.sprintf "<script id=\"MathJax-script\">%s</script>" t
    | Some (Remote r) ->
        Format.sprintf "<script id=\"MathJax-script\" src=\"%s\"></script>" r
    | None -> (
        match math_mode with
        | `Katex ->
            String.concat ""
            @@ [
                 Format.sprintf "<script>%s</script>"
                   (Katex.read "katex.min.js" |> Option.get);
                 Format.sprintf "<style>%s</style>"
                   (Katex.read "standalone-style.min.css" |> Option.get);
                 Format.sprintf "<script>%s</script>"
                   (Katex.read "auto-render.min.js" |> Option.get);
                 {|  <script>
        renderMathInElement(document.body, window.Katex);
</script>
|};
               ]
        | `Mathjax ->
            Format.sprintf "<script id=\"MathJax-script\">%s</script>"
              Data_files.(read Mathjax_js))

let mermaid_element has_mermaid =
  if not has_mermaid then ""
  else
    String.concat ""
      [
        "<script id=\"mermaid-script\">";
        Mermaid.read "mermaid.min.js" |> Option.get;
        "</script>";
        "<script>mermaid.initialize(window.Mermaid)</script>";
      ]

let css_element = function
  | Asset.Local { content = t; _ } -> Format.sprintf "<style>%s</style>" t
  | Remote r -> Format.sprintf {|<link href="%s" rel="stylesheet" />|} r

let theme_css = function
  | `Builtin theme ->
      Format.sprintf "<style>%s</style>" (Themes.content ~lite:true theme)
  | `External asset -> css_element asset

let internal_css =
  Format.sprintf "<style>%s</style>" Data_files.(read Slip_internal_css)

let system_css =
  Format.sprintf "<style>%s</style>" Data_files.(read Slip_system_css)

let variable_css ~width ~height =
  Format.sprintf
    "<style>:root {  --page-width: %dpx;  --page-height: %dpx;}</style>" width
    height

let slipshow_js_element slipshow_link =
  match slipshow_link with
  | Some (Asset.Local { content = t; _ }) ->
      Format.sprintf "<script>%s</script>" t
  | Some (Remote r) -> Format.sprintf "<script src=\"%s\"></script>" r
  | None -> Format.sprintf "<script>%s</script>" Data_files.(read Slipshow_js)

let head ~width ~height ~theme ~highlightjs_theme ~(has : Has.t) ~math_mode
    ~css_links =
  let theme = theme_css theme in
  let highlight_css_element =
    let s = Highlightjs.styles highlightjs_theme in
    "<style>" ^ s ^ "</style>"
  in
  let highlight_js_element = "<script>" ^ Highlightjs.script ^ "</script>" in
  let highlight_js_lang_elements =
    Highlightjs.lang_scripts has.code_blocks
    |> List.map (fun s -> "<script>" ^ s ^ "</script>")
    |> String.concat ""
  in
  let pdf_support =
    if has.pdf then
      "<script id=\"__pdf_support\">"
      ^ Data_files.(read Pdf_support)
      ^ "</script>"
    else ""
  in
  let favicon_element =
    let href =
      let mime_type = "image/x-icon" in
      let base64 = Base64.encode_string Data_files.(read Favicon) in
      Format.sprintf "data:%s;base64,%s" mime_type base64
    in
    Format.sprintf {|<link rel="icon" type="image/x-icon" href="%s">|} href
  in
  let css_elements = List.map css_element css_links |> String.concat "" in
  let math_option = math_option_elem math_mode ~has_math:has.math in
  let mermaid_option = mermaid_option_elem ~has_mermaid:has.mermaid in
  String.concat "\n"
    [
      pdf_support;
      variable_css ~width ~height;
      favicon_element;
      internal_css;
      system_css;
      theme;
      css_elements;
      highlight_css_element;
      highlight_js_element;
      highlight_js_lang_elements;
      math_option;
      mermaid_option;
    ]

let embed_in_page ~has_speaker_view ~slipshow_js content ~has ~math_link
    ~css_links ~js_links ~theme ~dimension ~highlightjs_theme ~math_mode =
  let width, height = dimension in
  let head =
    head ~has ~css_links ~theme ~width ~height ~highlightjs_theme ~math_mode
  in
  let slipshow_js_element = slipshow_js_element slipshow_js in
  let js =
    js_links
    |> List.map (function
         | Asset.Local { content = t; _ } ->
             Format.sprintf "<script>%s</script>" t
         | Remote r -> Format.sprintf {|<script src="%s"></script>|} r)
    |> String.concat ""
  in
  let mathjax_element = mathjax_element math_mode has.math math_link in
  let mermaid_element = mermaid_element has.mermaid in
  let start =
    String.concat ""
      [
        {|
<!doctype html>
<html>
  <head>|};
        (if has_speaker_view then {|    <base target="_parent">|} else "");
        {|
    <meta charset="utf-8" />
    |};
        head;
        {|
  </head>
  <body>
    <div id="slipshow-vertical-flex">
      <div id="slipshow-horizontal-flex">
        <div id="slipshow-main">
          <div id="slipshow-content">
            <svg id="slipshow-drawing-elem" style="overflow:visible; position: absolute; z-index:1000; pointer-events: none"></svg>
            |};
        content;
        {|
          </div>
          <div id="slip-touch-controls">
            <div class="slip-previous">←</div>
            <div class="slip-fullscreen">⇱</div>
            <div class="slip-next">→</div>
          </div>
          <div id="slipshow-counter">0</div>
        </div>
      </div>
    </div>
    <!-- Include the library -->
      |};
        slipshow_js_element;
        {|
    <!-- Start the presentation () -->
    <script>hljs.highlightAll();</script>|};
        mathjax_element;
        mermaid_element;
        {|    <script>
        async function startfunction () {
        if (typeof mermaid !== "undefined" )
          await mermaid.run();
        startSlipshow(|};
        string_of_int width;
        {|, |};
        string_of_int height;
        {|,|};
      ]
  in
  let end_ =
    Format.sprintf
      {|);
};
      startfunction()
    </script>%s
  </body>
</html>|}
      js
  in
  (start, end_, has_speaker_view)

type starting_state = int
type delayed = string * string * bool

let delayed_to_string s = Marshal.to_string s [] |> Base64.encode_string

let string_to_delayed s =
  let s =
    s |> Base64.decode |> function Ok x -> x | Error _ -> failwith "Hello11"
  in
  Marshal.from_string s 0

let convert_to_md ~read_file content =
  let (fm, content, loc_offset), _warnings =
    Diagnosis.with_ @@ fun () ->
    match Frontmatter.extract content with
    | None -> (Frontmatter.empty, content, (0, 0))
    | Some { frontmatter; rest; rest_offset; fm_offset } ->
        let file = "-" in
        let frontmatter = Frontmatter.of_string file fm_offset frontmatter in
        let to_asset = Asset.of_string ~read_file in
        let frontmatter = Frontmatter.resolve frontmatter ~to_asset in
        (frontmatter, rest, rest_offset)
  in
  let md =
    Cmarkit.Doc.of_string ~loc_offset ~heading_auto_ids:false ~strict:false
      content
  in
  let sd, _htbl_include = Compile.of_cmarkit ~read_file ~fm md in
  let sd = Compile.to_cmarkit sd in
  Cmarkit_commonmark.of_doc ~include_attributes:false sd

let to_grace file whole_content htbl_include er =
  Diagnosis.to_grace
    (fun f ->
      if file = Some f then
        Grace.Source.(`String { name = file; content = whole_content })
      else
        match Hashtbl.find_opt htbl_include f with
        | Some content -> Grace.Source.(`String { name = Some f; content })
        | None ->
            Grace.Source.(`String { name = file; content = whole_content }))
    er

let delayed ?slipshow_js ?(frontmatter = Frontmatter.empty) ?file
    ?(read_file = fun _ -> Ok None) ~has_speaker_view s =
  let whole_content = s in
  let (Frontmatter.Resolved frontmatter, s, loc_offset), warnings =
    Diagnosis.with_ @@ fun () ->
    match Frontmatter.extract s with
    | None -> (frontmatter, s, (0, 0))
    | Some { frontmatter = txt_fm; rest; rest_offset; fm_offset } ->
        let file = Option.value ~default:"-" file in
        let txt_fm = Frontmatter.of_string file fm_offset txt_fm in
        let to_asset = Asset.of_string ~read_file in
        let txt_frontmatter = Frontmatter.resolve txt_fm ~to_asset in
        let frontmatter = Frontmatter.combine txt_frontmatter frontmatter in
        (frontmatter, rest, rest_offset)
  in
  let toplevel_attributes =
    frontmatter.toplevel_attributes
    |> Option.value ~default:Frontmatter.Toplevel_attributes.default
  in
  let dimension =
    frontmatter.dimension |> Option.value ~default:Frontmatter.Dimension.default
  in
  let css_links = frontmatter.css_links in
  let js_links = frontmatter.js_links in
  let math_mode =
    Option.value ~default:Frontmatter.Math_mode.default frontmatter.math_mode
  in
  let resolve_theme = function
    | `Builtin _ as x -> x
    | `External x ->
        let asset = Asset.of_string ~read_file x in
        `External asset
  in
  let theme =
    match frontmatter.theme with
    | None -> resolve_theme Frontmatter.Theme.default
    | Some t -> resolve_theme t
  in
  let highlightjs_theme =
    Option.value ~default:Frontmatter.Hljs_theme.default
      frontmatter.highlightjs_theme
  in
  let math_link = frontmatter.math_link in
  let (md, htbl_include), errors =
    Compile.compile ~loc_offset ?file ~attrs:toplevel_attributes
      ~fm:(Frontmatter.Resolved frontmatter) ~read_file s
  in
  let warnings =
    List.filter_map
      (to_grace file whole_content htbl_include)
      (warnings @ errors)
  in
  let content = Renderers.to_html_string md in
  let has = Has.find_out md in
  let res =
    embed_in_page ~has_speaker_view ~slipshow_js ~dimension ~has ~math_link
      ~theme ~css_links ~js_links content ~highlightjs_theme ~math_mode
  in
  (res, warnings)

let add_starting_state ?(autofocus = true) (start, end_, has_speaker_view)
    (starting_state : starting_state option) =
  let autofocus = if autofocus then "autofocus" else "" in
  let starting_state =
    match starting_state with None -> "null" | Some st -> string_of_int st
  in
  let html = start ^ starting_state ^ end_ in
  let orig_html = html in
  let html =
    let buf = Buffer.create 10 in
    Cmarkit_html.buffer_add_html_escaped_string buf html;
    Buffer.contents buf
  in
  let favicon_element =
    let href =
      let mime_type = "image/x-icon" in
      let base64 = Base64.encode_string Data_files.(read Favicon) in
      Format.sprintf "data:%s;base64,%s" mime_type base64
    in
    Format.sprintf {|<link rel="icon" type="image/x-icon" href="%s">|} href
  in
  let html =
    String.concat ""
      [
        {|
<!doctype html>
<html>
  <head>
    <meta charset='utf-8'>
|};
        favicon_element;
        {|
  </head>
    <body>
      <iframe |};
        autofocus;
        {| name="slipshow_main_pres" id="slipshow__internal_iframe" srcdoc="|};
        html;
        {|" style="
    width: 100%;
    height: 100%;
    position: fixed;
    left: 0;
    border: 1px;
    right: 0;
    top: 0;
    bottom: 0;
"></iframe>

      <script>
|};
        Data_files.(read Scheduler_js);
        {|
      </script>
  </body>
</html>|};
      ]
  in
  if has_speaker_view then html else orig_html

let convert ~has_speaker_view ?autofocus ?slipshow_js ?frontmatter ?file
    ?starting_state ?read_file s =
  let delayed, w =
    delayed ~has_speaker_view ?slipshow_js ?frontmatter ?file ?read_file s
  in
  let res = add_starting_state ?autofocus delayed starting_state in
  (res, w)