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
(** *)
open Js_of_ocaml
module SMap = Map.Make(String)
let (+=) map (key, v) = map := SMap.add key v !map
let (-=) map key = map := SMap.remove key !map
type id = string
let log s = Firebug.console##log (Js.string s);;
let mk_msg_of_wsdata server_msg_of_yojson =
fun s ->
try
match server_msg_of_yojson (Yojson.Safe.from_string s) with
Error s -> failwith (s ^ "\n" ^ s)
| Ok msg -> Some msg
with
e ->
log (Printexc.to_string e);
None
let class_ s = "ojs-"^s
let setup_ws url msg_of_data ~onopen ~onmessage =
let on_message ws _ event =
try
log "message received on ws";
match msg_of_data (Js.to_string event##.data) with
None -> Js._false
| Some msg ->
onmessage ws msg;
Js._false
with
e ->
log (Printexc.to_string e);
Js._false
in
try
log ("connecting with websocket to "^url);
let ws = new%js WebSockets.webSocket(Js.string url) in
ws##.onmessage := Dom.full_handler (on_message ws) ;
ws##.onclose := Dom.handler (fun _ -> log "WS now CLOSED"; Js._false);
ws##.onopen := Dom.handler (fun _ -> onopen ws; Js._false) ;
Some ws
with e ->
log ("Could not connect to "^url);
log (Printexc.to_string e);
None
;;
let send_msg (ws : WebSockets.webSocket Js.t) data = ws##send (Js.string data)
let clear_children node =
let children = node##.childNodes in
for i = 0 to children##.length - 1 do
Js.Opt.iter node##.firstChild (fun n -> Dom.removeChild node n)
done
let node_by_id id =
let node = Dom_html.document##getElementById (Js.string id) in
Js.Opt.case node (fun _ -> failwith ("No node with id = "^id)) (fun x -> x)
let gen_id = let n = ref 0 in fun () -> incr n; Printf.sprintf "ojsid%d" !n
let set_onclick node f =
ignore(Dom_html.addEventListener node
Dom_html.Event.click
(Dom.handler (fun e -> f e; Js.bool true))
(Js.bool true))
let split_string ?(keep_empty=false) s chars =
let len = String.length s in
let rec iter acc pos =
if pos >= len then
match acc with
"" -> if keep_empty then [""] else []
| _ -> [acc]
else
if List.mem s.[pos] chars then
match acc with
"" ->
if keep_empty then
"" :: iter "" (pos + 1)
else
iter "" (pos + 1)
| _ -> acc :: (iter "" (pos + 1))
else
iter (Printf.sprintf "%s%c" acc s.[pos]) (pos + 1)
in
iter "" 0
let get_classes node =
let s =Js.to_string node##.className in
split_string s [' ']
let node_unset_class node cl =
node##.classList##remove (Js.string cl)
let node_set_class node cl =
node##.classList##add (Js.string cl)
let unset_class ~id cl =
try
let node = node_by_id id in
node_unset_class node cl
with
Failure msg -> log msg
let set_class ~id cl =
try
let node = node_by_id id in
node_set_class node cl
with
Failure msg -> log msg
let msg_base_class = class_"msg"
let msg_class_ s = Printf.sprintf "%s-%s" msg_base_class s
let display_message ?(timeout=3000.0) ?(cl=msg_class_"info") id msg_nodes =
let doc = Dom_html.document in
let node = node_by_id id in
let div = doc##createElement (Js.string "div") in
node_set_class div cl ;
node_set_class div msg_base_class ;
if timeout > 0. then
ignore(Dom_html.window##setTimeout
(Js.wrap_callback (fun () -> Dom.removeChild node div)) timeout
)
else
(
let b = doc##createElement (Js.string "span") in
node_set_class b (msg_class_"close") ;
let t = doc##createTextNode (Js.string "✘") in
set_onclick b (fun _ -> Dom.removeChild node div);
Dom.appendChild div b ;
Dom.appendChild b t
);
Dom.appendChild node div ;
List.iter (Dom.appendChild div) msg_nodes
let display_error id nodes = display_message ~timeout: 0. ~cl: (msg_class_"error") id nodes
let display_text_message ?timeout ?cl id text =
let t = Dom_html.document##createTextNode (Js.string text) in
display_message ?timeout ?cl id [t]
let display_text_error id text =
let t = Dom_html.document##createTextNode (Js.string text) in
display_error id [t]