diff --git a/src/dune b/src/dune index 4e2d45f..52d85ee 100644 --- a/src/dune +++ b/src/dune @@ -1,6 +1,6 @@ (library (public_name leaflet) - (modules event global latlng layer map popup point) + (modules event global latlng layer map popup point icon) (private_modules global) (libraries brr) (js_of_ocaml diff --git a/src/icon.ml b/src/icon.ml new file mode 100644 index 0000000..0073d68 --- /dev/null +++ b/src/icon.ml @@ -0,0 +1,47 @@ +(* BSD-2-Clause License *) + +type t = Jv.t + +type opt = + | Icon_retina_url of string + | Icon_size of Point.t + | Icon_anchor of Point.t + | Popup_anchor of Point.t + | Tooltip_anchor of Point.t + | Shadow_url of string + | Shadow_retina_url of string + | Shadow_size of Point.t + | Shadow_anchor of Point.t + | Class_name of string + | Cross_origin of string option + +let to_string = function + | Icon_retina_url _ -> "iconRetinaUrl" + | Icon_size _ -> "iconSize" + | Icon_anchor _ -> "iconAnchor" + | Popup_anchor _ -> "popupAnchor" + | Tooltip_anchor _ -> "tooltipAnchor" + | Shadow_url _ -> "shadowUrl" + | Shadow_retina_url _ -> "shadowRetinaUrl" + | Shadow_size _ -> "shadowSize" + | Shadow_anchor _ -> "shadowAnchor" + | Class_name _ -> "className" + | Cross_origin _ -> "crossOrigin" + +let to_jv = function + | Icon_size p + | Icon_anchor p + | Popup_anchor p + | Tooltip_anchor p + | Shadow_size p + | Shadow_anchor p -> + Point.to_jv p + | Icon_retina_url s | Shadow_url s | Shadow_retina_url s | Class_name s -> + Jv.of_string s + | Cross_origin o -> ( + 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 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 new file mode 100644 index 0000000..0d58709 --- /dev/null +++ b/src/icon.mli @@ -0,0 +1,21 @@ +(* BSD-2-Clause License *) + +type t + +(* type for icon option used to create an icon*) +type opt = + | Icon_retina_url of string + | Icon_size of Point.t + | Icon_anchor of Point.t + | Popup_anchor of Point.t + | Tooltip_anchor of Point.t + | Shadow_url of string + | Shadow_retina_url of string + | Shadow_size of Point.t + | Shadow_anchor of Point.t + | Class_name of string + | Cross_origin of string option + +(** [create icon_url options] Creates an icon instance with the given [options], + and the required `iconUrl` option set to [icon_url] *) +val create : string -> opt list -> t diff --git a/src/point.ml b/src/point.ml index 0191894..00fceb9 100644 --- a/src/point.ml +++ b/src/point.ml @@ -9,3 +9,6 @@ let of_jv point = let x = Jv.get point "x" |> Jv.to_int in let y = Jv.get point "y" |> Jv.to_int in { x; y } + +let to_jv point = + Jv.call Global.leaflet "point" [| Jv.of_int point.x; Jv.of_int point.y |] diff --git a/src/point.mli b/src/point.mli index 2ca4de2..a9b9430 100644 --- a/src/point.mli +++ b/src/point.mli @@ -7,3 +7,6 @@ type t = (** [of_jv jv] is [jv] as {!t} *) val of_jv : Jv.t -> t + +(** [to_jv o] is [o] as {!Jv.t} *) +val to_jv : t -> Jv.t