forked from swrup/leaflet
17 changed files with 152 additions and 163 deletions
@ -1,15 +1,7 @@ |
|||
(library |
|||
(public_name leaflet) |
|||
(modules |
|||
event |
|||
geojson_layer |
|||
global |
|||
latlng |
|||
layer |
|||
map |
|||
marker |
|||
popup |
|||
tile_layer) |
|||
(modules event global latlng layer map popup) |
|||
(private_modules global) |
|||
(libraries brr) |
|||
(js_of_ocaml |
|||
(javascript_files leaflet.js))) |
|||
|
@ -1,4 +0,0 @@ |
|||
include Layer |
|||
|
|||
let create ?(options = Jv.null) geojson = |
|||
of_jv_t @@ Jv.call Global.leaflet "geoJSON" [| geojson; options |] |
@ -1,23 +0,0 @@ |
|||
type t |
|||
|
|||
val create : ?options:Jv.t -> Jv.t -> t |
|||
|
|||
val add_to : Map.t -> t -> unit |
|||
|
|||
val remove : t -> unit |
|||
|
|||
val remove_from : Map.t -> t -> unit |
|||
|
|||
val bind_popup : Brr.El.t -> t -> unit |
|||
|
|||
val unbind_popup : t -> unit |
|||
|
|||
val open_popup : t -> unit |
|||
|
|||
val close_popup : t -> unit |
|||
|
|||
val get_popup : t -> Popup.t |
|||
|
|||
val of_jv_t : Jv.t -> t |
|||
|
|||
val to_jv_t : t -> Jv.t |
@ -1,23 +1,89 @@ |
|||
type t = Jv.t |
|||
type _ t = |
|||
| Basic : Jv.t -> [> `Basic ] t |
|||
| Geojson : Jv.t -> [> `Geojson ] t |
|||
| Marker : Jv.t -> [> `Marker ] t |
|||
| Tile : Jv.t -> [> `Tile ] t |
|||
|
|||
let add_to map layer = ignore @@ Jv.call layer "addTo" [| Map.to_jv_t map |] |
|||
(** Basic layers *) |
|||
|
|||
let remove layer = ignore @@ Jv.call layer "remove" [||] |
|||
let add_to : type kind. Map.t -> kind t -> unit = |
|||
fun map -> function |
|||
| Basic l | Geojson l | Marker l | Tile l -> |
|||
let (_ : Jv.t) = Jv.call l "addTo" [| Map.to_jv map |] in |
|||
() |
|||
|
|||
let remove_from map layer = |
|||
ignore @@ Jv.call layer "removeFrom" [| Map.to_jv_t map |] |
|||
let remove : type kind. kind t -> unit = function |
|||
| Basic l | Geojson l | Marker l | Tile l -> |
|||
let (_ : Jv.t) = Jv.call l "remove" [||] in |
|||
() |
|||
|
|||
let bind_popup el layer = |
|||
ignore @@ Jv.call layer "bindPopup" [| Brr.El.to_jv el |] |
|||
let remove_from : type kind. Map.t -> kind t -> unit = |
|||
fun map -> function |
|||
| Basic l | Geojson l | Marker l | Tile l -> |
|||
let (_ : Jv.t) = Jv.call l "removeFrom" [| Map.to_jv map |] in |
|||
() |
|||
|
|||
let unbind_popup layer = ignore @@ Jv.call layer "unbindPopup" [||] |
|||
let bind_popup : type kind. Brr.El.t -> kind t -> unit = |
|||
fun el -> function |
|||
| Basic l | Geojson l | Marker l | Tile l -> |
|||
let (_ : Jv.t) = Jv.call l "bindPopup" [| Brr.El.to_jv el |] in |
|||
() |
|||
|
|||
let open_popup layer = ignore @@ Jv.call layer "openPopup" [||] |
|||
let unbind_popup : type kind. kind t -> unit = function |
|||
| Basic l | Geojson l | Marker l | Tile l -> |
|||
let (_ : Jv.t) = Jv.call l "unbindPopup" [||] in |
|||
() |
|||
|
|||
let close_popup layer = ignore @@ Jv.call layer "closePopup" [||] |
|||
let open_popup : type kind. kind t -> unit = function |
|||
| Basic l | Geojson l | Marker l | Tile l -> |
|||
let (_ : Jv.t) = Jv.call l "openPopup" [||] in |
|||
() |
|||
|
|||
let get_popup layer = Popup.of_jv_t @@ Jv.call layer "getPopup" [||] |
|||
let close_popup : type kind. kind t -> unit = function |
|||
| Basic l | Geojson l | Marker l | Tile l -> |
|||
let (_ : Jv.t) = Jv.call l "closePopup" [||] in |
|||
() |
|||
|
|||
let of_jv_t = Fun.id |
|||
let get_popup : type kind. kind t -> Popup.t = function |
|||
| Basic l | Geojson l | Marker l | Tile l -> |
|||
Jv.call l "getPopup" [||] |> Popup.of_jv |
|||
|
|||
let to_jv_t = Fun.id |
|||
let to_jv : type kind. kind t -> Jv.t = function |
|||
| Basic l | Geojson l | Marker l | Tile l -> l |
|||
|
|||
(** Geojson layers *) |
|||
|
|||
let create_geojson : ?options:Jv.t -> Jv.t -> [ `Geojson ] t = |
|||
fun ?(options = Jv.null) geojson -> |
|||
let jv_t = Jv.call Global.leaflet "geoJSON" [| geojson; options |] in |
|||
Geojson jv_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 |
|||
Marker jv_t |
|||
|
|||
(** Tile layers *) |
|||
|
|||
let create_tile_osm : string option -> [ `Tile ] t = |
|||
fun url -> |
|||
(* see https://wiki.openstreetmap.org/wiki/Tile_servers *) |
|||
let url = |
|||
Option.value url |
|||
~default:"https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png" |
|||
in |
|||
let jv_t = |
|||
Jv.call Global.leaflet "tileLayer" |
|||
[| Jv.of_string url |
|||
; Jv.obj |
|||
[| ( "attribution" |
|||
, Jv.of_string |
|||
"© <a \ |
|||
href=\"https://www.openstreetmap.org/copyright\">OpenStreetMap</a> \ |
|||
contributors" ) |
|||
|] |
|||
|] |
|||
in |
|||
Tile jv_t |
|||
|
@ -1,21 +1,37 @@ |
|||
type t |
|||
type _ t = |
|||
| Basic : Jv.t -> [> `Basic ] t |
|||
| Geojson : Jv.t -> [> `Geojson ] t |
|||
| Marker : Jv.t -> [> `Marker ] t |
|||
| Tile : Jv.t -> [> `Tile ] t |
|||
|
|||
val add_to : Map.t -> t -> unit |
|||
(** Basic layers *) |
|||
|
|||
val remove : t -> unit |
|||
val add_to : Map.t -> _ t -> unit |
|||
|
|||
val remove_from : Map.t -> t -> unit |
|||
val remove : _ t -> unit |
|||
|
|||
val bind_popup : Brr.El.t -> t -> unit |
|||
val remove_from : Map.t -> _ t -> unit |
|||
|
|||
val unbind_popup : t -> unit |
|||
val bind_popup : Brr.El.t -> _ t -> unit |
|||
|
|||
val open_popup : t -> unit |
|||
val unbind_popup : _ t -> unit |
|||
|
|||
val close_popup : t -> unit |
|||
val open_popup : _ t -> unit |
|||
|
|||
val get_popup : t -> Popup.t |
|||
val close_popup : _ t -> unit |
|||
|
|||
val of_jv_t : Jv.t -> t |
|||
val get_popup : _ t -> Popup.t |
|||
|
|||
val to_jv_t : t -> Jv.t |
|||
val to_jv : _ t -> Jv.t |
|||
|
|||
(** Geojson layers *) |
|||
|
|||
val create_geojson : ?options:Jv.t -> Jv.t -> [ `Geojson ] t |
|||
|
|||
(** Marker layers *) |
|||
|
|||
val create_marker : Latlng.t -> [ `Marker ] t |
|||
|
|||
(** Tile layers *) |
|||
|
|||
val create_tile_osm : string option -> [ `Tile ] t |
|||
|
@ -1,38 +1,43 @@ |
|||
type t = Jv.t |
|||
|
|||
let of_jv_t = Fun.id |
|||
let of_jv = Fun.id |
|||
|
|||
let to_jv_t = Fun.id |
|||
let to_jv = Fun.id |
|||
|
|||
let create ?(options = Jv.null) container_id = |
|||
Jv.call Global.leaflet "map" [| Jv.of_string container_id; options |] |
|||
|
|||
let invalidate_size map = ignore @@ Jv.call map "invalidateSize" [| Jv.true' |] |
|||
let invalidate_size map = |
|||
let (_ : Jv.t) = Jv.call map "invalidateSize" [| Jv.true' |] in |
|||
() |
|||
|
|||
let fit_world map = ignore @@ Jv.call map "fitWorld" [||] |
|||
let fit_world map = |
|||
let (_ : Jv.t) = Jv.call map "fitWorld" [||] in |
|||
() |
|||
|
|||
let get_container map = |
|||
Jv.call (to_jv_t map) "getContainer" [||] |> Brr.El.of_jv |
|||
let get_container map = Jv.call (to_jv map) "getContainer" [||] |> Brr.El.of_jv |
|||
|
|||
let set_view latlng ?zoom map = |
|||
let latlng = Latlng.to_jv_t latlng in |
|||
ignore |
|||
@@ |
|||
match zoom with |
|||
| None -> Jv.call map "setView" [| latlng |] |
|||
| Some zoom -> Jv.call map "setView" [| latlng; Jv.of_int zoom |] |
|||
let set_view latlng ~zoom map = |
|||
let latlng = Latlng.to_jv latlng in |
|||
let (_ : Jv.t) = |
|||
match zoom with |
|||
| None -> Jv.call map "setView" [| latlng |] |
|||
| Some zoom -> Jv.call map "setView" [| latlng; Jv.of_int zoom |] |
|||
in |
|||
() |
|||
|
|||
let as_target map = Brr.Ev.target_of_jv map |
|||
|
|||
let on : type kind. kind Event.sub -> (kind Event.t -> 'b) -> t -> unit = |
|||
fun event handler map -> |
|||
let name = Event.sub_to_string event in |
|||
let handler v = handler @@ Event.of_jv_t event v in |
|||
ignore @@ Jv.call map "on" [| Jv.of_string name; Jv.repr handler |] |
|||
let handler v = handler @@ Event.of_jv event v in |
|||
let (_ : Jv.t) = Jv.call map "on" [| Jv.of_string name; Jv.repr handler |] in |
|||
() |
|||
|
|||
let get_center map = Latlng.of_jv_t @@ Jv.call map "getCenter" [||] |
|||
let get_center map = Latlng.of_jv @@ Jv.call map "getCenter" [||] |
|||
|
|||
let get_zoom map = Jv.call map "getZoom" [||] |> Jv.to_int |
|||
|
|||
let wrapped_latlng latlng map = |
|||
Latlng.of_jv_t @@ Jv.call map "wrapLatLng" [| Latlng.to_jv_t latlng |] |
|||
Latlng.of_jv @@ Jv.call map "wrapLatLng" [| Latlng.to_jv latlng |] |
|||
|
@ -1,4 +0,0 @@ |
|||
include Layer |
|||
|
|||
let create latlng = |
|||
of_jv_t @@ Jv.call Global.leaflet "marker" [| Latlng.to_jv_t latlng |] |
@ -1,23 +0,0 @@ |
|||
type t |
|||
|
|||
val create : Latlng.t -> t |
|||
|
|||
val add_to : Map.t -> t -> unit |
|||
|
|||
val remove : t -> unit |
|||
|
|||
val remove_from : Map.t -> t -> unit |
|||
|
|||
val bind_popup : Brr.El.t -> t -> unit |
|||
|
|||
val unbind_popup : t -> unit |
|||
|
|||
val open_popup : t -> unit |
|||
|
|||
val close_popup : t -> unit |
|||
|
|||
val get_popup : t -> Popup.t |
|||
|
|||
val of_jv_t : Jv.t -> t |
|||
|
|||
val to_jv_t : t -> Jv.t |
@ -1,19 +0,0 @@ |
|||
include Layer |
|||
|
|||
let create_osm ?tile_url () = |
|||
(* see https://wiki.openstreetmap.org/wiki/Tile_servers *) |
|||
let tile_url = |
|||
Option.fold ~some:Fun.id |
|||
~none:"https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png" tile_url |
|||
in |
|||
of_jv_t |
|||
@@ Jv.call Global.leaflet "tileLayer" |
|||
[| Jv.of_string tile_url |
|||
; Jv.obj |
|||
[| ( "attribution" |
|||
, Jv.of_string |
|||
"© <a \ |
|||
href=\"https://www.openstreetmap.org/copyright\">OpenStreetMap</a> \ |
|||
contributors" ) |
|||
|] |
|||
|] |
@ -1,23 +0,0 @@ |
|||
type t |
|||
|
|||
val create_osm : ?tile_url:string -> unit -> t |
|||
|
|||
val add_to : Map.t -> t -> unit |
|||
|
|||
val remove : t -> unit |
|||
|
|||
val remove_from : Map.t -> t -> unit |
|||
|
|||
val bind_popup : Brr.El.t -> t -> unit |
|||
|
|||
val unbind_popup : t -> unit |
|||
|
|||
val open_popup : t -> unit |
|||
|
|||
val close_popup : t -> unit |
|||
|
|||
val get_popup : t -> Popup.t |
|||
|
|||
val of_jv_t : Jv.t -> t |
|||
|
|||
val to_jv_t : t -> Jv.t |
Loading…
Reference in new issue