From fbcb87f0d86c235190be9ba10bac4d23018da5d0 Mon Sep 17 00:00:00 2001
From: Swrup <swrup@protonmail.com>
Date: Mon, 20 Jun 2022 08:16:21 +0200
Subject: [PATCH] add marker options

---
 src/icon.ml   |  6 ++++--
 src/icon.mli  |  3 +++
 src/layer.ml  | 49 ++++++++++++++++++++++++++++++++++++++++++++++---
 src/layer.mli | 16 +++++++++++++++-
 4 files changed, 68 insertions(+), 6 deletions(-)

diff --git a/src/icon.ml b/src/icon.ml
index 0073d68..369c288 100644
--- a/src/icon.ml
+++ b/src/icon.ml
@@ -2,6 +2,8 @@
 
 type t = Jv.t
 
+let to_jv = Fun.id
+
 type opt =
   | Icon_retina_url of string
   | Icon_size of Point.t
@@ -28,7 +30,7 @@ let to_string = function
   | Class_name _ -> "className"
   | Cross_origin _ -> "crossOrigin"
 
-let to_jv = function
+let opt_to_jv = function
   | Icon_size p
   | Icon_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 )
 
 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
   Jv.call Global.leaflet "icon" [| Jv.obj tab |]
diff --git a/src/icon.mli b/src/icon.mli
index 0d58709..df3b33e 100644
--- a/src/icon.mli
+++ b/src/icon.mli
@@ -2,6 +2,9 @@
 
 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 opt =
   | Icon_retina_url of string
diff --git a/src/layer.ml b/src/layer.ml
index beef402..7f34d54 100644
--- a/src/layer.ml
+++ b/src/layer.ml
@@ -85,9 +85,52 @@ let create_geojson : ?options:Jv.t -> Jv.t -> [ `Geojson ] t =
 
 (** Marker layers *)
 
-let create_marker : Latlng.t -> [ `Marker ] t =
- fun latlng ->
-  let jv_t = Jv.call Global.leaflet "marker" [| Latlng.to_jv latlng |] in
+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
+
+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
 
 (** Tile layers *)
diff --git a/src/layer.mli b/src/layer.mli
index 309d1f5..9f85a0a 100644
--- a/src/layer.mli
+++ b/src/layer.mli
@@ -55,8 +55,22 @@ val create_geojson : ?options:Jv.t -> Jv.t -> [ `Geojson ] t
 
 (** 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 *)
-val create_marker : Latlng.t -> [ `Marker ] t
+val create_marker : Latlng.t -> marker_opt list -> [ `Marker ] t
 
 (** Tile layers *)