add tile_layer_opt; untested
This commit is contained in:
parent
6a58f6ff30
commit
65ee38b4ee
3 changed files with 78 additions and 19 deletions
|
|
@ -4,7 +4,7 @@ let map = Leaflet.Map.create_on "map"
|
||||||
(* setup map *)
|
(* setup map *)
|
||||||
let () =
|
let () =
|
||||||
(* set osm layer *)
|
(* set osm layer *)
|
||||||
let osm_layer = Leaflet.Layer.create_tile_osm None in
|
let osm_layer = Leaflet.Layer.create_tile_osm [] in
|
||||||
Leaflet.Layer.add_to map osm_layer;
|
Leaflet.Layer.add_to map osm_layer;
|
||||||
|
|
||||||
(* set view *)
|
(* set view *)
|
||||||
|
|
|
||||||
73
src/layer.ml
73
src/layer.ml
|
|
@ -120,22 +120,65 @@ let create_geojson : Jv.t -> geojson_opt list -> [ `Geojson ] t =
|
||||||
|
|
||||||
(** Tile layers *)
|
(** Tile layers *)
|
||||||
|
|
||||||
let create_tile_osm : string option -> [ `Tile ] t =
|
type tile_layer_opt =
|
||||||
fun url ->
|
| Min_zoom of int
|
||||||
let url =
|
| Max_zoom of int
|
||||||
Option.value url
|
| Subdomains of string array
|
||||||
~default:"https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png"
|
| Error_tile_url of string
|
||||||
|
| Zoom_offset of int
|
||||||
|
| Tms of bool
|
||||||
|
| Zoom_reverse of bool
|
||||||
|
| Detect_retina of bool
|
||||||
|
(* TODO allow string for those two
|
||||||
|
"Whether the crossOrigin attribute will be added to the tiles. If a String is provided, all tiles will have their crossOrigin attribute set to the String provided. This is needed if you want to access tile pixel data. Refer to CORS Settings for valid String values."
|
||||||
|
*)
|
||||||
|
| Cross_origin of bool
|
||||||
|
| Referrer_policy of bool
|
||||||
|
|
||||||
|
let tile_layer_opt_to_string = function
|
||||||
|
| Min_zoom _ -> "minZoom"
|
||||||
|
| Max_zoom _ -> "maxZoom"
|
||||||
|
| Subdomains _ -> "subdomains"
|
||||||
|
| Error_tile_url _ -> "errorTileUrl"
|
||||||
|
| Zoom_offset _ -> "zoomOffset"
|
||||||
|
| Tms _ -> "tms"
|
||||||
|
| Zoom_reverse _ -> "zoomReverse"
|
||||||
|
| Detect_retina _ -> "detectRetina"
|
||||||
|
| Cross_origin _ -> "crossOrigin"
|
||||||
|
| Referrer_policy _ -> "referrerPolicy"
|
||||||
|
|
||||||
|
let tile_layer_opt_to_jv = function
|
||||||
|
| Min_zoom o | Max_zoom o | Zoom_offset o -> Jv.of_int o
|
||||||
|
| Tms o
|
||||||
|
| Zoom_reverse o
|
||||||
|
| Detect_retina o
|
||||||
|
| Cross_origin o
|
||||||
|
| Referrer_policy o ->
|
||||||
|
Jv.of_bool o
|
||||||
|
| Error_tile_url o -> Jv.of_string o
|
||||||
|
| Subdomains o -> Jv.of_array Jv.of_string o
|
||||||
|
|
||||||
|
let create_tile :
|
||||||
|
string -> attribution:string -> tile_layer_opt list -> [ `Tile ] t =
|
||||||
|
fun url ~attribution options ->
|
||||||
|
let arr =
|
||||||
|
Array.of_list
|
||||||
|
@@ ("attribution", Jv.of_string attribution)
|
||||||
|
:: List.map
|
||||||
|
(fun o -> (tile_layer_opt_to_string o, tile_layer_opt_to_jv o))
|
||||||
|
options
|
||||||
in
|
in
|
||||||
let jv_t =
|
let jv_t =
|
||||||
Jv.call Global.leaflet "tileLayer"
|
Jv.call Global.leaflet "tileLayer" [| Jv.of_string url; Jv.obj arr |]
|
||||||
[| Jv.of_string url
|
|
||||||
; Jv.obj
|
|
||||||
[| ( "attribution"
|
|
||||||
, Jv.of_string
|
|
||||||
"© <a \
|
|
||||||
href=\"https://www.openstreetmap.org/copyright\">OpenStreetMap</a> \
|
|
||||||
contributors" )
|
|
||||||
|]
|
|
||||||
|]
|
|
||||||
in
|
in
|
||||||
Tile jv_t
|
Tile jv_t
|
||||||
|
|
||||||
|
let create_tile_osm : tile_layer_opt list -> [ `Tile ] t =
|
||||||
|
fun options ->
|
||||||
|
let url = "https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png" in
|
||||||
|
let attribution =
|
||||||
|
"© <a \
|
||||||
|
href=\"https://www.openstreetmap.org/copyright\">OpenStreetMap</a> \
|
||||||
|
contributors"
|
||||||
|
in
|
||||||
|
create_tile url ~attribution options
|
||||||
|
|
|
||||||
|
|
@ -64,7 +64,23 @@ val create_geojson : Jv.t -> geojson_opt list -> [ `Geojson ] t
|
||||||
|
|
||||||
(** Tile layers *)
|
(** Tile layers *)
|
||||||
|
|
||||||
(** [create_tile_osm Some(url)] is a new tile layer with tile server specified
|
type tile_layer_opt =
|
||||||
by [url]. Tile server default to [openstreetmap.org]. See
|
| Min_zoom of int
|
||||||
|
| Max_zoom of int
|
||||||
|
| Subdomains of string array
|
||||||
|
| Error_tile_url of string
|
||||||
|
| Zoom_offset of int
|
||||||
|
| Tms of bool
|
||||||
|
| Zoom_reverse of bool
|
||||||
|
| Detect_retina of bool
|
||||||
|
| Cross_origin of bool
|
||||||
|
| Referrer_policy of bool
|
||||||
|
|
||||||
|
(** [create_tile url attribution opts] create a new tile layer *)
|
||||||
|
val create_tile :
|
||||||
|
string -> attribution:string -> tile_layer_opt list -> [ `Tile ] t
|
||||||
|
|
||||||
|
(** [create_tile_osm opts] create a new tile layer with tile server and
|
||||||
|
attribution set to [openstreetmap.org]. See
|
||||||
{:https://wiki.openstreetmap.org/wiki/Tile_servers} *)
|
{:https://wiki.openstreetmap.org/wiki/Tile_servers} *)
|
||||||
val create_tile_osm : string option -> [ `Tile ] t
|
val create_tile_osm : tile_layer_opt list -> [ `Tile ] t
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue