use gadts for event, clean repo
This commit is contained in:
parent
d9f25e4d8d
commit
f4ab3e17ad
8 changed files with 118 additions and 126 deletions
59
src/event.ml
Normal file
59
src/event.ml
Normal file
|
|
@ -0,0 +1,59 @@
|
|||
type _ t =
|
||||
| Keyboard : Jv.t -> [> `Keyboard ] t
|
||||
| Mouse : Jv.t -> [> `Mouse ] t
|
||||
| Error : Jv.t -> [> `Error ] t
|
||||
| Basic : Jv.t -> [> `Basic ] t
|
||||
|
||||
type _ sub =
|
||||
| Click : [> `Mouse ] sub
|
||||
| Move_end : [> `Basic ] sub
|
||||
| Zoom_end : [> `Basic ] sub
|
||||
|
||||
let of_jv_t : type kind. kind sub -> Jv.t -> kind t =
|
||||
fun tag e ->
|
||||
match tag with Click -> Mouse e | Move_end -> Basic e | Zoom_end -> Basic e
|
||||
|
||||
let sub_to_string : type kind. kind sub -> string = function
|
||||
| Click -> "click"
|
||||
| Move_end -> "moveend"
|
||||
| Zoom_end -> "zoomend"
|
||||
|
||||
(** Basic events *)
|
||||
|
||||
let get_type : type kind. kind t -> string = function
|
||||
| Keyboard e | Mouse e | Error e | Basic e -> Jv.get e "type" |> Jv.to_string
|
||||
|
||||
let target : type kind. kind t -> Brr.Ev.target = function
|
||||
| Keyboard e | Mouse e | Error e | Basic e ->
|
||||
Jv.get e "target" |> Brr.Ev.target_of_jv
|
||||
|
||||
let source_target : type kind. kind t -> Brr.Ev.target = function
|
||||
| Keyboard e | Mouse e | Error e | Basic e ->
|
||||
Jv.get e "sourceTarget" |> Brr.Ev.target_of_jv
|
||||
|
||||
let propagated_from : type kind. kind t -> Jv.t = function
|
||||
| Keyboard e | Mouse e | Error e | Basic e -> Jv.get e "propagatedFrom"
|
||||
|
||||
(** Keyboard & Mouse events *)
|
||||
|
||||
let original_event : [ `Keyboard | `Mouse ] t -> Jv.t = function
|
||||
| Keyboard e | Mouse e -> Jv.get e "originalEvent"
|
||||
|
||||
(** Mouse events *)
|
||||
|
||||
let container_point : [ `Mouse ] t -> Jv.t = function
|
||||
| Mouse e -> Jv.get e "containerPoint"
|
||||
|
||||
let layer_point : [ `Mouse ] t -> Jv.t = function
|
||||
| Mouse e -> Jv.get e "layerPoint"
|
||||
|
||||
let latlng : [ `Mouse ] t -> Latlng.t = function
|
||||
| Mouse e -> Jv.get e "latlng" |> Latlng.of_jv_t
|
||||
|
||||
(** Error events *)
|
||||
|
||||
let code : [ `Error ] t -> int = function
|
||||
| Error e -> Jv.get e "code" |> Jv.to_int
|
||||
|
||||
let message : [ `Error ] t -> string = function
|
||||
| Error e -> Jv.get e "message" |> Jv.to_string
|
||||
Loading…
Add table
Add a link
Reference in a new issue