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