utilsWeb.ml 6 KB
Newer Older
Benoit Barbot's avatar
update    
Benoit Barbot committed
1
open Js_of_ocaml
Benoit Barbot's avatar
Benoit Barbot committed
2

Benoit Barbot's avatar
Benoit Barbot committed
3
type t = Dom.node Js.t
Benoit Barbot's avatar
Benoit Barbot committed
4

Benoit Barbot's avatar
Benoit Barbot committed
5
let txt value =
Benoit Barbot's avatar
Benoit Barbot committed
6
7
  let text = Dom_html.document##createTextNode (Js.string value) in
  (text :> t)
Benoit Barbot's avatar
Benoit Barbot committed
8
9

let append_node parent node =
Benoit Barbot's avatar
Benoit Barbot committed
10
  let (_ : Dom.node Js.t) = parent##appendChild node in
Benoit Barbot's avatar
Benoit Barbot committed
11
12
13
14
15
16
  ()

let br () =
  let br = Dom_html.(createBr document) in
  (br :> t)

Benoit Barbot's avatar
Benoit Barbot committed
17
let ul ?id items =
Benoit Barbot's avatar
Benoit Barbot committed
18
  let ul = Dom_html.(createUl document) in
Benoit Barbot's avatar
Benoit Barbot committed
19
  (match id with None -> () | Some ids -> ul##.id := Js.string ids);
Benoit Barbot's avatar
Benoit Barbot committed
20
  List.iter (append_node ul) items;
Benoit Barbot's avatar
Benoit Barbot committed
21
  (ul :> t)
Benoit Barbot's avatar
Benoit Barbot committed
22

Benoit Barbot's avatar
Benoit Barbot committed
23
let tr ?id items =
Benoit Barbot's avatar
Benoit Barbot committed
24
  let tr = Dom_html.(createTr document) in
Benoit Barbot's avatar
Benoit Barbot committed
25
  (match id with None -> () | Some ids -> tr##.id := Js.string ids);
Benoit Barbot's avatar
Benoit Barbot committed
26
  List.iter (append_node tr) items;
Benoit Barbot's avatar
Benoit Barbot committed
27
  (tr :> t)
Benoit Barbot's avatar
Benoit Barbot committed
28

Benoit Barbot's avatar
Benoit Barbot committed
29
let td ?id items =
Benoit Barbot's avatar
Benoit Barbot committed
30
  let td = Dom_html.(createTd document) in
Benoit Barbot's avatar
Benoit Barbot committed
31
  (match id with None -> () | Some ids -> td##.id := Js.string ids);
Benoit Barbot's avatar
Benoit Barbot committed
32
  List.iter (append_node td) items;
Benoit Barbot's avatar
Benoit Barbot committed
33
  (td :> t)
Benoit Barbot's avatar
Benoit Barbot committed
34

Benoit Barbot's avatar
Benoit Barbot committed
35
let table ?id items =
Benoit Barbot's avatar
Benoit Barbot committed
36
  let table = Dom_html.(createTable document) in
Benoit Barbot's avatar
Benoit Barbot committed
37
  (match id with None -> () | Some ids -> table##.id := Js.string ids);
Benoit Barbot's avatar
Benoit Barbot committed
38
  List.iter (append_node table) items;
Benoit Barbot's avatar
Benoit Barbot committed
39
  (table :> t)
Benoit Barbot's avatar
Benoit Barbot committed
40

Benoit Barbot's avatar
Benoit Barbot committed
41
let div_raw ?(class_ = "") ?(title = "") ?id items =
Benoit Barbot's avatar
Benoit Barbot committed
42
43
44
45
46
47
48
  let div = Dom_html.(createDiv document) in
  List.iter (append_node div) items;
  (match id with None -> () | Some ids -> div##.id := Js.string ids);
  div##.title := Js.string title;
  div##.className := Js.string class_;
  div

Benoit Barbot's avatar
Benoit Barbot committed
49
let div ?(class_ = "") ?(title = "") ?id items =
Benoit Barbot's avatar
Benoit Barbot committed
50
51
52
53
54
55
56
57
58
59
60
  let div = Dom_html.(createDiv document) in
  List.iter (append_node div) items;
  (match id with None -> () | Some ids -> div##.id := Js.string ids);
  div##.title := Js.string title;
  div##.className := Js.string class_;
  (div :> t)

let p ?(class_ = "") items =
  let p = Dom_html.(createP document) in
  List.iter (append_node p) items;
  p##.className := Js.string class_;
Benoit Barbot's avatar
Benoit Barbot committed
61
  (p :> t)
Benoit Barbot's avatar
Benoit Barbot committed
62
63
64
65

let button ?(class_ = "") ?(on_click = fun () -> ()) items =
  let button = Dom_html.(createButton document) in
  let append_node node =
Benoit Barbot's avatar
Benoit Barbot committed
66
    let (_ : Dom.node Js.t) = button##appendChild node in
Benoit Barbot's avatar
Benoit Barbot committed
67
68
69
70
    ()
  in
  List.iter append_node items;
  button##.className := Js.string class_;
Benoit Barbot's avatar
Benoit Barbot committed
71
72
73
74
  let on_click _ =
    on_click ();
    Js._true
  in
Benoit Barbot's avatar
Benoit Barbot committed
75
76
77
  button##.onclick := Dom.handler on_click;
  (button :> t)

Benoit Barbot's avatar
Benoit Barbot committed
78
let option ?(def = false) value =
Benoit Barbot's avatar
Benoit Barbot committed
79
80
81
82
83
84
  let opt = Dom_html.(createOption document) in
  (*opt##.value := Js.string value;*)
  append_node opt (txt value);
  if def then opt##.defaultSelected := Js._true;
  (opt :> t)

Benoit Barbot's avatar
Benoit Barbot committed
85
86
let choice_input ?(class_ = "") ?(init_value = None) ?(on_change = fun _ -> ())
    sl =
Benoit Barbot's avatar
Benoit Barbot committed
87
  let sel = Dom_html.(createSelect document) in
Benoit Barbot's avatar
Benoit Barbot committed
88
89
90
91
92
93
94
95
96
97
98
  List.iter
    (fun s ->
      append_node sel
        (option
           ~def:(match init_value with None -> false | Some x -> x = s)
           s))
    (">" :: sl);
  let on_input _ =
    on_change (Js.to_string sel##.value);
    Js._true
  in
Benoit Barbot's avatar
Benoit Barbot committed
99
100
101
102
  sel##.oninput := Dom.handler on_input;
  sel##.className := Js.string class_;
  (sel :> t)

Benoit Barbot's avatar
Benoit Barbot committed
103
let check_input ?(class_ = "") ?(on_change = fun _ -> true) value =
Benoit Barbot's avatar
Benoit Barbot committed
104
  let input = Dom_html.(createInput ~_type:(Js.string "checkbox") document) in
Benoit Barbot's avatar
Benoit Barbot committed
105
106
107
  input##.checked := Js.bool value;
  let on_input _ =
    let b = string_of_bool (Js.to_bool input##.checked) in
Benoit Barbot's avatar
Benoit Barbot committed
108
109
110
    let _ = on_change b in
    Js._true
  in
Benoit Barbot's avatar
Benoit Barbot committed
111
112
113
  input##.oninput := Dom.handler on_input;
  input##.className := Js.string class_;
  (input :> t)
Benoit Barbot's avatar
Benoit Barbot committed
114

Benoit Barbot's avatar
add id    
Benoit Barbot committed
115
116
let text_input ?(class_ = "") ?(id = "") ?(on_change = fun _ -> true)
    ?(_type = "text") value =
Benoit Barbot's avatar
Benoit Barbot committed
117
118
  (*let input2 = input ~a:[a_input_type `Text] () in
    let input = Eliom_content.Html.To_dom.of_input input2 in*)
Benoit Barbot's avatar
Benoit Barbot committed
119
  let input = Dom_html.(createInput ~_type:(Js.string _type) document) in
Benoit Barbot's avatar
init  
Benoit Barbot committed
120
  input##.value := Js.string value;
Benoit Barbot's avatar
add id    
Benoit Barbot committed
121
  input##.id := Js.string id;
Benoit Barbot's avatar
init  
Benoit Barbot committed
122
123
124
125
  let on_input _ =
    let res = on_change (Js.to_string input##.value) in
    if res then input##.style##.color := Js.string "green"
    else input##.style##.color := Js.string "red";
Benoit Barbot's avatar
Benoit Barbot committed
126
127
    Js._true
  in
Benoit Barbot's avatar
init  
Benoit Barbot committed
128
129
  input##.oninput := Dom.handler on_input;
  input##.className := Js.string class_;
Benoit Barbot's avatar
Benoit Barbot committed
130
  (input :> t)
Benoit Barbot's avatar
init  
Benoit Barbot committed
131

Benoit Barbot's avatar
prog    
Benoit Barbot committed
132
let update_link n f =
Benoit Barbot's avatar
Benoit Barbot committed
133
134
  let link = Dom_html.(createA document) in
  append_node link (txt n);
Benoit Barbot's avatar
Benoit Barbot committed
135
  let currref = Js.to_string Dom_html.window##.location##.pathname in
Benoit Barbot's avatar
Benoit Barbot committed
136
137
138
139
140
141
  link##.onmouseover :=
    Dom.handler (fun _ ->
        let string_value = f currref in
        link##.href := Js.string string_value;
        Js._true);
  (link :> t)
Benoit Barbot's avatar
Benoit Barbot committed
142

Benoit Barbot's avatar
Benoit Barbot committed
143
let color_input ?(class_ = "") ?(on_change = fun _ -> true) value =
Benoit Barbot's avatar
Benoit Barbot committed
144
  let input = Dom_html.(createInput ~_type:(Js.string "color") document) in
Benoit Barbot's avatar
Benoit Barbot committed
145
  (*let input2 = input ~a:[a_input_type `Color] () in
Benoit Barbot's avatar
Benoit Barbot committed
146
147
148
    let input = Eliom_content.Html.To_dom.of_input input2 in*)
  input##.value :=
    Js.string (DrawingGeom.Color.to_string (DrawingGeom.Color.parse value));
Benoit Barbot's avatar
prog    
Benoit Barbot committed
149
150
151
152
  let on_input _ =
    let res = on_change (Js.to_string input##.value) in
    if res then input##.style##.color := Js.string "green"
    else input##.style##.color := Js.string "red";
Benoit Barbot's avatar
Benoit Barbot committed
153
154
    Js._true
  in
Benoit Barbot's avatar
prog    
Benoit Barbot committed
155
156
  input##.oninput := Dom.handler on_input;
  input##.className := Js.string class_;
Benoit Barbot's avatar
Benoit Barbot committed
157
  (input :> t)
Benoit Barbot's avatar
Benoit Barbot committed
158

Benoit Barbot's avatar
Benoit Barbot committed
159
160
161
162
163
164
let change_file (cb : string -> unit) _ =
  let id2 = Js.string "filein" in
  let f s = cb (Js.to_string s) in
  Js.Unsafe.fun_call
    (Js.Unsafe.js_expr "upload")
    [| Js.Unsafe.inject f; Js.Unsafe.inject id2 |]
Benoit Barbot's avatar
Benoit Barbot committed
165
166

let rec split_attr s i =
Benoit Barbot's avatar
Benoit Barbot committed
167
168
169
170
171
172
173
174
175
176
177
178
  match String.index_from_opt s i '=' with
  | Some j -> (
      let opt = String.sub s i (j - i) in
      match String.index_from_opt s (j + 1) '&' with
      | Some k -> (opt, String.sub s (j + 1) (k - j - 1)) :: split_attr s (k + 1)
      | None -> [ (opt, String.sub s (j + 1) (String.length s - j - 1)) ] )
  | None -> []

let getURL s =
  let query = Js.to_string Dom_html.window##.location##.search in
  let m = split_attr query 1 in
  List.assoc_opt s m
Benoit Barbot's avatar
Benoit Barbot committed
179
180
181
182
183
184
185

let run html =
  let on_load _ =
    let html = html () in
    let body =
      let find_tag name =
        let elements =
Benoit Barbot's avatar
Benoit Barbot committed
186
          Dom_html.window##.document##getElementsByTagName (Js.string name)
Benoit Barbot's avatar
Benoit Barbot committed
187
188
        in
        let element =
Benoit Barbot's avatar
Benoit Barbot committed
189
190
191
          Js.Opt.get
            (elements##item 0)
            (fun () -> failwith ("find_tag(" ^ name ^ ")"))
Benoit Barbot's avatar
Benoit Barbot committed
192
193
194
195
196
        in
        element
      in
      find_tag "body"
    in
Benoit Barbot's avatar
Benoit Barbot committed
197
    let (_ : t) = body##appendChild html in
Benoit Barbot's avatar
Benoit Barbot committed
198
199
200
    Js._false
  in
  Dom_html.window##.onload := Dom.handler on_load