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
199
200
201
202
203
204
205
206
207
208
209
open Brr
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;
preview_status : 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" |> Window.of_jv
in
let window = content_window panel in
let msg =
{ payload; id = "TODO" } |> Communication.to_string |> Jv.of_string
in
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%
}
.preview-status-elem {
position: absolute;
top: 20px;
right: 132px;
width: 50px;
height: 50px;
z-index: 10;
display: block;
border: 5px solid rgba(150, 150, 150);
border-top: 5px solid #3498db;
border-radius: 50%;
animation: spin 1s linear infinite;
}
/* Define the rotation */
@keyframes spin {
0% { transform: rotate(0deg); }
100% { transform: rotate(360deg); }
}
/* Hide when active */
.preview-status-elem.preview-status {
display: none;
}|}
let preview_status_class = Jstr.v "preview-status"
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 =
El.iframe ~at:[ At.name !!name1; At.class' !!"right-panel1" ] []
in
let panel2 =
El.iframe ~at:[ At.name !!name2; At.class' !!"right-panel2" ] []
in
let preview_status =
El.div ~at:[ At.class' !!"preview-status-elem preview-status" ] []
in
let css = El.style [ El.txt' css ] in
let () = El.append_children root [ panel1; panel2; css; preview_status ] 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 _ =
Ev.listen Brr_io.Message.Ev.message
(fun event ->
let ( let> ) x f = Option.iter f x in
let> source = Brr_io.Message.Ev.source (Ev.as_type event) in
let source_name = Jv.get source "name" |> Jv.to_string in
let raw_data : Jv.t = Brr_io.Message.Ev.data (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) ->
Jv.set (El.to_jv panels.(!index)) "srcdoc" (Jv.of_string "");
let () = El.set_class preview_status_class true preview_status in
if !is_speaker_view_open then
send_speaker_view `Open panels.(1 - !index);
index := 1 - !index;
El.set_class (Jstr.v "active_panel") true panels.(!index);
let () =
if steal_focus then
let contentDocument el =
Jv.get (El.to_jv el) "contentDocument" |> Document.of_jv
in
let focus_target =
let d = contentDocument panels.(!index) in
match
Document.find_el_by_id d
(Jstr.v "slipshow__internal_iframe")
with
| Some iframe -> iframe
| None -> panels.(!index)
in
El.set_has_focus true focus_target
in
El.set_class (Jstr.v "active_panel") false panels.(1 - !index)
| _ -> ())
(Window.as_target G.window)
in
{
stage;
index;
panels;
ids = (name1, name2);
include_speaker_view;
errors_el;
preview_status;
}
let set_errors errors_el warnings =
let innerhtml el v =
let _ = Jv.set (El.to_jv el) "innerHTML" (Jv.of_string v) in
()
in
innerhtml errors_el warnings
let set_srcdoc { index; panels; errors_el; preview_status; _ }
(slipshow, warnings) =
set_errors errors_el warnings;
try Jv.set (El.to_jv panels.(1 - !index)) "srcdoc" (Jv.of_string slipshow)
with exn ->
El.set_class preview_status_class true preview_status;
Console.(log [ "exception"; Printexc.to_string exn ])
let preview ?options ?slipshow_js previewer source =
let () = El.set_class preview_status_class false previewer.preview_status in
let starting_state = !(previewer.stage) in
let has_speaker_view = previewer.include_speaker_view in
let this_file = Fpath.v "-" in
let read_file f =
if Fpath.equal this_file f then Ok (Some source) else Ok None
in
let slipshow, warnings =
Slipshow.convert ~has_speaker_view ?slipshow_js ?options ~read_file
~autofocus:false ~starting_state this_file
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 () = El.set_class preview_status_class false previewer.preview_status in
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