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
module Msg = struct
type msg = Communication.t
let of_jv m : msg option = m |> Jv.to_string |> Communication.of_string
end
type previewer = {
stage : int ref;
index : int ref;
panels : Brr.El.t array;
errors_el : Brr.El.t;
ids : string * string;
include_speaker_view : bool;
}
let send_speaker_view oc panel =
let payload =
match oc with
| `Open -> Communication.Open_speaker_notes
| `Close -> Close_speaker_notes
in
let content_window w =
Jv.get (Brr.El.to_jv w) "contentWindow" |> Brr.Window.of_jv
in
let window = content_window panel in
let msg =
{ payload; id = "TODO" } |> Communication.to_string |> Jv.of_string
in
Brr.Window.post_message window ~msg
let () = Random.self_init ()
let css =
{|
.right-panel1.active_panel, .right-panel2.active_panel {
z-index: 1;
}
.right-panel1, .right-panel2 {
z-index: 0;
width:100%;
position:absolute;
top:0;
bottom:0;
left:0;
right:0;
border:0;
height:100%
}
|}
let create_previewer ?(initial_stage = 0) ?(callback = fun _ -> ())
~include_speaker_view ~errors_el ~steal_focus root =
let ( !! ) = Jstr.v in
let name1 = Random.int 1000000 |> string_of_int |> fun s -> "id" ^ s in
let name2 = Random.int 1000000 |> string_of_int |> fun s -> "id" ^ s in
let ids = [| name1; name2 |] in
let panel1 =
Brr.El.iframe ~at:[ Brr.At.name !!name1; Brr.At.class' !!"right-panel1" ] []
in
let panel2 =
Brr.El.iframe ~at:[ Brr.At.name !!name2; Brr.At.class' !!"right-panel2" ] []
in
let css = Brr.El.style [ Brr.El.txt' css ] in
let () = Brr.El.append_children root [ panel1; panel2; css ] in
let panels = [| panel1; panel2 |] in
let index = ref 0 in
let stage = ref initial_stage in
let is_speaker_view_open = ref false in
let _ =
Brr.Ev.listen Brr_io.Message.Ev.message
(fun event ->
let source =
Brr_io.Message.Ev.source (Brr.Ev.as_type event) |> Option.get
in
let source_name = Jv.get source "name" |> Jv.to_string in
let raw_data : Jv.t = Brr_io.Message.Ev.data (Brr.Ev.as_type event) in
let msg = Msg.of_jv raw_data in
match msg with
| Some { payload = State (new_stage, _mode); id = _ }
when String.equal source_name ids.(!index) ->
callback new_stage;
stage := new_stage
| Some { payload = Open_speaker_notes; id = _ }
when String.equal source_name ids.(!index) ->
is_speaker_view_open := true
| Some { payload = Close_speaker_notes; id = _ }
when String.equal source_name ids.(!index) ->
is_speaker_view_open := false
| Some { payload = Ready; id = _ }
when String.equal source_name ids.(!index) ->
()
| Some { payload = Ready; id }
when String.equal source_name ids.(1 - !index) ->
Brr.Console.(log [ "Getting a strange input"; id ]);
if !is_speaker_view_open then (
send_speaker_view `Close panels.(!index);
send_speaker_view `Open panels.(1 - !index));
index := 1 - !index;
Brr.El.set_class (Jstr.v "active_panel") true panels.(!index);
let () =
if steal_focus then
let contentDocument el =
Jv.get (Brr.El.to_jv el) "contentDocument"
|> Brr.Document.of_jv
in
let inner_iframe =
panels.(!index) |> contentDocument |> fun d ->
Brr.Document.find_el_by_id d
(Jstr.v "slipshow__internal_iframe")
|> Option.get
in
Brr.El.set_has_focus true inner_iframe
in
Brr.El.set_class (Jstr.v "active_panel") false panels.(1 - !index)
| _ -> ())
(Brr.Window.as_target Brr.G.window)
in
{
stage;
index;
panels;
ids = (name1, name2);
include_speaker_view;
errors_el;
}
let set_errors errors_el warnings =
let innerhtml el v =
let _ = Jv.set (Brr.El.to_jv el) "innerHTML" (Jv.of_string v) in
()
in
innerhtml errors_el warnings
let set_srcdoc { index; panels; errors_el; _ } (slipshow, warnings) =
set_errors errors_el warnings;
try Jv.set (Brr.El.to_jv panels.(1 - !index)) "srcdoc" (Jv.of_string slipshow)
with _ -> Brr.Console.(log [ "XXX exception" ])
let preview ?slipshow_js ?frontmatter ?read_file previewer source =
let starting_state = !(previewer.stage) in
let has_speaker_view = previewer.include_speaker_view in
let slipshow, warnings =
Slipshow.convert ~file:"-" ~has_speaker_view ?slipshow_js ?frontmatter
?read_file ~autofocus:false ~starting_state source
in
let warnings =
List.map
(Format.asprintf "%a@.@."
(Grace_ansi_renderer.pp_diagnostic ?config:None
~code_to_string:Diagnosis.to_code))
warnings
|> List.map (Ansi.process (Ansi.create ()))
|> String.concat ""
in
set_srcdoc previewer (slipshow, warnings)
let preview_compiled previewer (delayed, warnings) =
let starting_state = Some !(previewer.stage) in
let slipshow = Slipshow.add_starting_state delayed starting_state in
set_srcdoc previewer (slipshow, warnings)
let ids { ids; _ } = ids