package slipshow

  1. Overview
  2. Docs

Source file slipshow.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
module Asset = Asset
module Frontmatter = Frontmatter

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

let mathjax_element 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 ->
        Format.sprintf "<script id=\"MathJax-script\">%s</script>"
          Data_files.(read Mathjax_js)

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 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 ~(has : Has.t) ~math_link ~css_links =
  let theme = theme_css theme in
  let highlight_css_element =
    "<style>" ^ Data_files.(read Highlight_css) ^ "</style>"
  in
  let highlight_js_element =
    "<script>" ^ Data_files.(read Highlight_js) ^ "</script>"
  in
  let highlight_js_ocaml_element =
    "<script>" ^ Data_files.(read Highlight_js_ocaml) ^ "</script>"
  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 mathjax_element = mathjax_element has.math math_link in
  let css_elements = List.map css_element css_links |> String.concat "" in
  String.concat "\n"
    [
      pdf_support;
      variable_css ~width ~height;
      favicon_element;
      mathjax_element;
      internal_css;
      system_css;
      theme;
      css_elements;
      highlight_css_element;
      highlight_js_element;
      highlight_js_ocaml_element;
    ]

let embed_in_page content ~has ~math_link ~css_links ~theme ~dimension =
  let width, height = dimension in
  let head = head ~has ~math_link ~css_links ~theme ~width ~height in
  let slipshow_js_element = slipshow_js_element None in
  let start =
    Format.sprintf
      {|
<!doctype html>
<html>
  <head>
    <meta charset="utf-8" />
    %s
  </head>
  <body>
    <div id="slipshow-main">
      <div id="slipshow-content">
        <svg id="slipshow-drawing-elem" style="overflow:visible; position: absolute; z-index:1000"></svg>
        %s
      </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>

    <!-- Include the library -->
    %s
    <!-- Start the presentation () -->
    <script>hljs.highlightAll();</script>
    <script>
      startSlipshow(%d, %d,|}
      head content slipshow_js_element width height
  in
  let end_ = {|);
    </script>
  </body>
                   </html>|} in
  (start, end_)

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

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

let string_to_delayed s =
  let s = s |> Base64.decode |> Result.get_ok in
  Marshal.from_string s 0

let convert_to_md ~read_file content =
  let md = Cmarkit.Doc.of_string ~heading_auto_ids:true ~strict:false content in
  let sd = Compile.of_cmarkit ~read_file md in
  let sd = Compile.to_cmarkit sd in
  Cmarkit_commonmark.of_doc ~include_attributes:false sd

let delayed ?(frontmatter = Frontmatter.empty) ?(read_file = fun _ -> Ok None) s
    =
  let Frontmatter.Resolved frontmatter, s =
    let ( let* ) x f =
      match x with
      | Ok x -> f x
      | Error (`Msg err) ->
          Logs.err (fun m -> m "Failed to parse the frontmatter: %s" err);
          (frontmatter, s)
    in
    match Frontmatter.extract s with
    | None -> (frontmatter, s)
    | Some (yaml, s) ->
        let* txt_frontmatter = Frontmatter.of_string yaml in
        let to_asset = Asset.of_string ~read_file in
        let txt_frontmatter = Frontmatter.resolve txt_frontmatter ~to_asset in
        let frontmatter = Frontmatter.combine frontmatter txt_frontmatter in
        (frontmatter, s)
  in
  let toplevel_attributes =
    frontmatter.toplevel_attributes
    |> Option.value ~default:Frontmatter.Default.toplevel_attributes
  in
  let dimension =
    frontmatter.dimension |> Option.value ~default:Frontmatter.Default.dimension
  in
  let css_links =
    frontmatter.css_links (* |> List.map (Asset.of_string ~read_file) *)
  in
  let theme =
    match frontmatter.theme with
    | None -> Frontmatter.Default.theme
    | Some (`Builtin _ as x) -> x
    | Some (`External x) ->
        let asset = Asset.of_string ~read_file x in
        `External asset
  in
  let math_link =
    frontmatter.math_link (* |> Option.map (Asset.of_string ~read_file) *)
  in
  let md = Compile.compile ~attrs:toplevel_attributes ~read_file s in
  let content = Renderers.to_html_string md in
  let has = Has.find_out md in
  embed_in_page ~dimension ~has ~math_link ~theme ~css_links content

let add_starting_state (start, end_) starting_state =
  let starting_state =
    match starting_state with
    | None -> ""
    | Some (st, id) -> string_of_int st ^ ", \"" ^ id ^ "\""
  in
  start ^ starting_state ^ end_

let convert ?frontmatter ?starting_state ?read_file s =
  let delayed = delayed ?frontmatter ?read_file s in
  add_starting_state delayed starting_state