add marker options

This commit is contained in:
Swrup 2022-06-20 08:16:21 +02:00
parent db88d3f670
commit 96a7307bf3
4 changed files with 68 additions and 6 deletions

View file

@ -2,6 +2,8 @@
type t = Jv.t type t = Jv.t
let to_jv = Fun.id
type opt = type opt =
| Icon_retina_url of string | Icon_retina_url of string
| Icon_size of Point.t | Icon_size of Point.t
@ -28,7 +30,7 @@ let to_string = function
| Class_name _ -> "className" | Class_name _ -> "className"
| Cross_origin _ -> "crossOrigin" | Cross_origin _ -> "crossOrigin"
let to_jv = function let opt_to_jv = function
| Icon_size p | Icon_size p
| Icon_anchor p | Icon_anchor p
| Popup_anchor p | Popup_anchor p
@ -42,6 +44,6 @@ let to_jv = function
match o with Some s -> Jv.of_string s | None -> Jv.of_bool false ) match o with Some s -> Jv.of_string s | None -> Jv.of_bool false )
let create icon_url options = let create icon_url options =
let l = List.map (fun o -> (to_string o, to_jv o)) options in let l = List.map (fun o -> (to_string o, opt_to_jv o)) options in
let tab = Array.of_list @@ (("iconUrl", Jv.of_string icon_url) :: l) in let tab = Array.of_list @@ (("iconUrl", Jv.of_string icon_url) :: l) in
Jv.call Global.leaflet "icon" [| Jv.obj tab |] Jv.call Global.leaflet "icon" [| Jv.obj tab |]

View file

@ -2,6 +2,9 @@
type t type t
(** [to_jv o] is [o] as {!Jv.t} *)
val to_jv : t -> Jv.t
(* type for icon option used to create an icon*) (* type for icon option used to create an icon*)
type opt = type opt =
| Icon_retina_url of string | Icon_retina_url of string

View file

@ -85,9 +85,52 @@ let create_geojson : ?options:Jv.t -> Jv.t -> [ `Geojson ] t =
(** Marker layers *) (** Marker layers *)
let create_marker : Latlng.t -> [ `Marker ] t = type marker_opt =
fun latlng -> | Icon of Icon.t
let jv_t = Jv.call Global.leaflet "marker" [| Latlng.to_jv latlng |] in | Keyboard of bool
| Title of string
| Alt of string
| Z_index_offset of int
| Opacity of float
| Rise_on_hover of bool
| Rise_offset of int
| Pane of string
| Shadow_pane of string
| Bubbling_mouse_events of bool
| Auto_pan_on_focus of bool
let marker_opt_to_string : marker_opt -> string = function
| Icon _ -> "icon"
| Keyboard _ -> "keyboard"
| Title _ -> "title"
| Alt _ -> "alt"
| Z_index_offset _ -> "zIndexOffset"
| Opacity _ -> "opacity"
| Rise_on_hover _ -> "riseOnHover"
| Rise_offset _ -> "riseOffset"
| Pane _ -> "pane"
| Shadow_pane _ -> "shadowPane"
| Bubbling_mouse_events _ -> "bubblingMouseEvents"
| Auto_pan_on_focus _ -> "autoPanOnFocus"
let marker_opt_to_jv = function
| Icon icon -> Icon.to_jv icon
| Keyboard b | Rise_on_hover b | Bubbling_mouse_events b | Auto_pan_on_focus b
->
Jv.of_bool b
| Title s | Alt s | Pane s | Shadow_pane s -> Jv.of_string s
| Z_index_offset i | Rise_offset i -> Jv.of_int i
| Opacity f -> Jv.of_float f
let create_marker : Latlng.t -> marker_opt list -> [ `Marker ] t =
fun latlng options ->
let l =
Array.of_list
@@ List.map (fun o -> (marker_opt_to_string o, marker_opt_to_jv o)) options
in
let jv_t =
Jv.call Global.leaflet "marker" [| Latlng.to_jv latlng; Jv.obj l |]
in
Marker jv_t Marker jv_t
(** Tile layers *) (** Tile layers *)

View file

@ -55,8 +55,22 @@ val create_geojson : ?options:Jv.t -> Jv.t -> [ `Geojson ] t
(** Marker layers *) (** Marker layers *)
type marker_opt =
| Icon of Icon.t
| Keyboard of bool
| Title of string
| Alt of string
| Z_index_offset of int
| Opacity of float
| Rise_on_hover of bool
| Rise_offset of int
| Pane of string
| Shadow_pane of string
| Bubbling_mouse_events of bool
| Auto_pan_on_focus of bool
(** [create_marker latlng] is a new marker with the same position as latlng *) (** [create_marker latlng] is a new marker with the same position as latlng *)
val create_marker : Latlng.t -> [ `Marker ] t val create_marker : Latlng.t -> marker_opt list -> [ `Marker ] t
(** Tile layers *) (** Tile layers *)