add marker options
This commit is contained in:
parent
69024b75da
commit
6aca93ebe9
4 changed files with 68 additions and 6 deletions
|
|
@ -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 |]
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
49
src/layer.ml
49
src/layer.ml
|
|
@ -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 *)
|
||||||
|
|
|
||||||
|
|
@ -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 *)
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue