viz.js/dispatch.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

open Js_of_ocaml

type event_container =
    E : 'a Dom.Event.typ * ('a -> unit) -> event_container

type event_key = K : 'a Dom.Event.typ -> event_key

type t = event_container

let (catalog:event_container list ref) = ref []

let register: type a. a Dom.Event.typ -> (a -> unit) -> t =
  begin fun event callback ->
    let handler = E (event, callback) in
    catalog := handler::!catalog;
    handler
  end

let remove: type a. a Dom.Event.typ -> t -> unit =
  begin fun _event callback ->
    catalog := List.filter (fun reg -> reg != callback)  !catalog;
  end

let call: type a. a Dom.Event.typ -> a -> unit =
  begin fun event value ->
    List.iter (fun (E (registered_event, callback)) ->
        if K event = K registered_event then
          callback (Obj.magic value)
      ) !catalog
  end