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
|
open JSOO
open Boot
module type PARAMS = sig
type v (* event valuation *)
val name : string
val destruct : obj -> v
val default_value : v option
(* an error message is produced if default value is None
* and the destruction failed *)
end
module Make = functor (Params : PARAMS) ->
struct
open Params
exception Cannot_destruct of exn
let handlers_field = "caml_" ^ name ^ "_handlers"
let bind f obj =
let handlers =
try
Obj.obj (obj >>> get handlers_field >>> as_block)
with Failure "as_block" ->
(* first event handler *)
let handlers = ref [] in
obj >>> set handlers_field (inject (Block (Obj.repr handlers))) ;
obj >>> set name
(wrap_event
(fun evt ->
let v =
try destruct evt with e ->
match default_value with
| Some v -> v
| None -> raise (Cannot_destruct e)
in
List.iter (fun f -> f v) !handlers)) ;
handlers
in handlers := f :: (List.filter ((!=) f) !handlers)
let unbind f obj =
let handlers =
try
Obj.obj (obj >>> get handlers_field >>> as_block)
with Failure "as_block" ->
ref []
in
handlers := List.filter ((!=) f) !handlers ;
if !handlers = [] then (
obj >>> set handlers_field (inject Nil) ;
obj >>> set name (inject Nil)
)
let clear () obj =
obj >>> set handlers_field (inject Nil) ;
obj >>> set name (inject Nil)
end
module Mouse_move = Make (
struct
type v = int * int
let name = "onmousemove"
let destruct obj =
(obj >>> get "clientX" >>> as_int,
obj >>> get "clientY" >>> as_int)
let default_value = None
end
)
module Mouse_up = Make (
struct
type v = int * int
let name = "onmouseup"
let destruct obj =
(obj >>> get "clientX" >>> as_int,
obj >>> get "clientY" >>> as_int)
let default_value = None
end
)
module Mouse_down = Make (
struct
type v = int * int
let name = "onmousedown"
let destruct obj =
(obj >>> get "clientX" >>> as_int,
obj >>> get "clientY" >>> as_int)
let default_value = None
end
)
|
