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