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
open! Core
open! Import
open! Bonsai_web
open! Bonsai.Let_syntax
open! Js_of_ocaml
let set_cursor s = Dom_html.window##.document##.body##.style##.cursor := Js.string s
module Mouse_event = struct
module T = struct
type t =
| Down
| Up
| Move
[@@deriving sexp, compare, equal]
end
include T
include Comparable.Make (T)
let to_dom_html = function
| Down -> Dom_html.Event.mousedown
| Up -> Dom_html.Event.mouseup
| Move -> Dom_html.Event.mousemove
;;
end
module State = struct
type t =
{ mutable listeners : Dom.event_listener_id Mouse_event.Map.t
; mutable animation_id : Dom_html.animation_frame_request_id
; mutable mouse_x : int option
}
[@@deriving fields]
let create () =
let animation_id = request_animation_frame (Fn.const ()) in
Fields.create ~listeners:Mouse_event.Map.empty ~animation_id ~mouse_x:None
;;
let remove_event_listener = Option.iter ~f:Dom_html.removeEventListener
let destroy { listeners; animation_id; mouse_x = _ } =
Map.iter listeners ~f:Dom_html.removeEventListener;
cancel_animation_frame animation_id
;;
let on_mouse_event state element ~f ~event =
remove_event_listener (Map.find state.listeners event);
let id = add_event_listener element (Mouse_event.to_dom_html event) ~f in
state.listeners <- Map.set state.listeners ~key:event ~data:id
;;
let remove_mouse_event state ~event =
remove_event_listener (Map.find state.listeners event)
;;
let cancel_schedule state = cancel_animation_frame state.animation_id
let schedule state ~f =
cancel_schedule state;
state.animation_id <- request_animation_frame f
;;
let set_mouse_x state x = state.mouse_x <- Some x
let clear_mouse_x state = state.mouse_x <- None
end
let get_parent element =
let%bind.Option parent = Js.Opt.to_option element##.parentNode in
Js.Opt.to_option (Dom_html.CoerceTo.element parent)
;;
let rec do_update_width target state =
let (_ : unit option) =
let open Option.Let_syntax in
let%bind mouse_x = State.mouse_x state in
let%bind target = Js.Opt.to_option target in
let%bind parent = get_parent target in
let rect = parent##getBoundingClientRect in
let left = rect##.left in
let new_width = Int.to_float mouse_x -. left in
set_width parent new_width;
return ()
in
State.clear_mouse_x state;
State.schedule state ~f:(fun _ -> do_update_width target state)
;;
module T = struct
module Input = struct
include Unit
let combine () () = ()
end
module State = State
let init () element =
let state = State.create () in
let on_mouse_move _ event = State.set_mouse_x state event##.clientX in
let on_mouse_up _ _ =
set_cursor "initial";
State.remove_mouse_event state ~event:Move;
State.remove_mouse_event state ~event:Up;
State.cancel_schedule state
in
let on_mouse_down _ event =
let target = event##.target in
State.clear_mouse_x state;
do_update_width target state;
State.on_mouse_event ~event:Move state Dom_html.document ~f:on_mouse_move;
State.on_mouse_event ~event:Up state Dom_html.document ~f:on_mouse_up;
set_cursor "col-resize"
in
State.on_mouse_event state element ~f:on_mouse_down ~event:Down;
state
;;
let on_mount () _state element =
Option.iter (get_parent element) ~f:Freeze.Expert.set_width
;;
let update ~old_input:() ~new_input:() _state _element = ()
let destroy () state (element : Dom_html.element Js.t) =
set_cursor "initial";
Option.iter (get_parent element) ~f:Freeze.Expert.reset_width;
State.destroy state
;;
end
module Hook = Vdom.Attr.Hooks.Make (T)
let attr = Vdom.Attr.create_hook "resizer" (Hook.create ())