diff --git a/src/dune b/src/dune index a2d7907..e7f3daf 100644 --- a/src/dune +++ b/src/dune @@ -1,7 +1,7 @@ (library (name leaflet) (public_name leaflet) - (modules leaflet) + (modules ev latlng geojson_layer tile_layer popup marker map global) (libraries brr js_of_ocaml) (js_of_ocaml (javascript_files leaflet.js))) diff --git a/src/ev.ml b/src/ev.ml new file mode 100644 index 0000000..d4f9aad --- /dev/null +++ b/src/ev.ml @@ -0,0 +1,12 @@ +type type' = Jv.t + +module Event = struct + (*type for simple Event *) + type t = type' +end + +module Mouse = struct + type t = type' + + let latlng e = Latlng.of_jv_t @@ Jv.get e "latlng" +end diff --git a/src/ev.mli b/src/ev.mli new file mode 100644 index 0000000..0a93bcf --- /dev/null +++ b/src/ev.mli @@ -0,0 +1,11 @@ +type type' + +module Event : sig + type t +end + +module Mouse : sig + type t + + val latlng : t -> Latlng.t +end diff --git a/src/geojson_layer.ml b/src/geojson_layer.ml new file mode 100644 index 0000000..66ed14a --- /dev/null +++ b/src/geojson_layer.ml @@ -0,0 +1,7 @@ +(*TODO merge with TileLayer*) +type t = Jv.t + +let create ?(options = Jv.null) geojson = + Jv.call Global.leaflet "geoJSON" [| geojson; options |] + +let add_to layer map = ignore @@ Jv.call layer "addTo" [| Map.to_jv_t map |] diff --git a/src/geojson_layer.mli b/src/geojson_layer.mli new file mode 100644 index 0000000..12bb980 --- /dev/null +++ b/src/geojson_layer.mli @@ -0,0 +1,5 @@ +type t + +val create : ?options:Jv.t -> Jv.t -> t + +val add_to : t -> Map.t -> unit diff --git a/src/global.ml b/src/global.ml new file mode 100644 index 0000000..c209f3d --- /dev/null +++ b/src/global.ml @@ -0,0 +1,4 @@ +let leaflet = + match Jv.(find global "L") with + | Some l -> l + | None -> failwith "Could not load Leaflet" diff --git a/src/latlng.ml b/src/latlng.ml new file mode 100644 index 0000000..d2b4dbc --- /dev/null +++ b/src/latlng.ml @@ -0,0 +1,14 @@ +type t = Jv.t + +let create lat lng = + Jv.call Global.leaflet "latLng" [| Jv.of_float lat; Jv.of_float lng |] + +let lat latlng = Jv.get latlng "lat" |> Jv.to_float + +let lng latlng = Jv.get latlng "lng" |> Jv.to_float + +let equals a b = Jv.call a "equals" [| b |] |> Jv.to_bool + +let of_jv_t = Fun.id + +let to_jv_t = Fun.id diff --git a/src/latlng.mli b/src/latlng.mli new file mode 100644 index 0000000..fb793ae --- /dev/null +++ b/src/latlng.mli @@ -0,0 +1,13 @@ +type t + +val create : float -> float -> t + +val lat : t -> float + +val lng : t -> float + +val equals : t -> t -> bool + +val of_jv_t : Jv.t -> t + +val to_jv_t : t -> Jv.t diff --git a/src/leaflet.ml b/src/leaflet.ml deleted file mode 100644 index fca38f9..0000000 --- a/src/leaflet.ml +++ /dev/null @@ -1,121 +0,0 @@ -(* - * SPDX-FileCopyrightText: 2021 pukkamustard - * - * SPDX-License-Identifier: AGPL-3.0-or-later - *) -open Brr - -let leaflet = - match Jv.(find global "L") with - | Some l -> l - | None -> failwith "Could not load Leaflet" - -module LatLng = struct - type t = Jv.t - - let create lat lng = - Jv.call leaflet "latLng" [| Jv.of_float lat; Jv.of_float lng |] - - let lat latlng = Jv.get latlng "lat" |> Jv.to_float - - let lng latlng = Jv.get latlng "lng" |> Jv.to_float - - let equals a b = Jv.call a "equals" [| b |] |> Jv.to_bool -end - -module Ev = struct - module MouseEvent = struct - type t = Jv.t - - let latlng e = Jv.get e "latlng" - end -end - -module Map = struct - type t = Jv.t - - let create ?(options = Jv.null) container_id = - Jv.call leaflet "map" [| Jv.of_string container_id; options |] - - let invalidate_size map = - ignore @@ Jv.call map "invalidateSize" [| Jv.true' |] - - let fit_world map = ignore @@ Jv.call map "fitWorld" [||] - - let get_container map = Jv.call map "getContainer" [||] |> El.of_jv - - let set_view latlng ?zoom map = - ignore - @@ - match zoom with - | None -> Jv.call map "setView" [| latlng |] - | Some zoom -> Jv.call map "setView" [| latlng; Jv.of_int zoom |] - - let as_target map = Brr.Ev.target_of_jv map - - let click = Brr.Ev.Type.create (Jstr.v "click") - (*?= let click = Brr.Ev.click *) - - let on ~event ~handler map = - ignore @@ Jv.call map "on" [| Jv.of_string event; Jv.repr handler |] - - let get_center map = Jv.call map "getCenter" [||] - - let get_zoom map = Jv.call map "getZoom" [||] |> Jv.to_int - - let wrapped_latlng latlng map = Jv.call map "wrapLatLng" [| latlng |] -end - -module TileLayer = struct - type t = Jv.t - - let create_osm () = - Jv.call leaflet "tileLayer" - [| Jv.of_string "https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png" - ; Jv.obj - [| ( "attribution" - , Jv.of_string - "© OpenStreetMap \ - contributors" ) - |] - |] - - let add_to tile_layer map = ignore @@ Jv.call tile_layer "addTo" [| map |] -end - -module GeojsonLayer = struct - type t = Jv.t - - let create ?(options = Jv.null) geojson = - Jv.call leaflet "geoJSON" [| geojson; options |] - - let add_to layer map = ignore @@ Jv.call layer "addTo" [| map |] -end - -module Marker = struct - type t = Jv.t - - let create latlng = Jv.call leaflet "marker" [| latlng |] - - let add_to marker map = ignore @@ Jv.call marker "addTo" [| map |] - - let bind_popup el marker = - ignore @@ Jv.call marker "bindPopup" [| El.to_jv el |]; - marker - - let open_popup marker = ignore @@ Jv.call marker "openPopup" [||] -end - -module Popup = struct - let popup = Jv.call leaflet "popup" [||] - - let set_latlng latlng = ignore @@ Jv.call popup "setLatLng" [| latlng |] - - let set_content content = - ignore @@ Jv.call popup "setContent" [| Jv.of_string content |] - - let open_on map = ignore @@ Jv.call popup "openOn" [| map |] - - let close map = ignore @@ Jv.call map "closePopup" [||] -end diff --git a/src/leaflet.mli b/src/leaflet.mli deleted file mode 100644 index dd166cf..0000000 --- a/src/leaflet.mli +++ /dev/null @@ -1,103 +0,0 @@ -(* - * SPDX-FileCopyrightText: 2021 pukkamustard - * - * SPDX-License-Identifier: AGPL-3.0-or-later - *) - -(** {1 Leaflet} - - This module provides bindings to the Leaflet JavaScript library for - mobile-friendly interactive maps. - - See also the [Leaflet API reference](https://leafletjs.com/reference.html). *) -open Brr - -module LatLng : sig - type t - - val create : float -> float -> t - - val lat : t -> float - - val lng : t -> float - - val equals : t -> t -> bool -end - -module Ev : sig - module MouseEvent : sig - type t - - val latlng : t -> LatLng.t - end -end - -module Map : sig - type t - - val create : ?options:Jv.t -> string -> t - - val invalidate_size : t -> unit - - val set_view : LatLng.t -> ?zoom:int -> t -> unit - - val fit_world : t -> unit - - val get_container : t -> El.t - - val on : event:string -> handler:('a -> 'b) -> t -> unit - - val get_center : t -> LatLng.t - - val get_zoom : t -> int - - val wrapped_latlng : LatLng.t -> t -> LatLng.t - - (** {1 Events} **) - - val as_target : t -> Brr.Ev.target - - (** {2 Interaction events} **) - - val click : Ev.MouseEvent.t Brr.Ev.type' -end - -module TileLayer : sig - type t - - val create_osm : unit -> t - - val add_to : t -> Map.t -> unit -end - -module GeojsonLayer : sig - type t - - val create : ?options:Jv.t -> Jv.t -> t - - val add_to : t -> Map.t -> unit -end - -module Marker : sig - type t - - val create : LatLng.t -> t - - val add_to : t -> Map.t -> unit - - (** {2 Popup methods} *) - - val bind_popup : El.t -> t -> t - - val open_popup : t -> unit -end - -module Popup : sig - val set_latlng : LatLng.t -> unit - - val set_content : string -> unit - - val open_on : Map.t -> unit - - val close : Map.t -> unit -end diff --git a/src/map.ml b/src/map.ml new file mode 100644 index 0000000..3efedd7 --- /dev/null +++ b/src/map.ml @@ -0,0 +1,46 @@ +type t = Jv.t + +module Event = struct + let to_brr s = s |> Jstr.v |> Brr.Ev.Type.create + + let click = to_brr "click" + + let moveend = to_brr "moveend" + + let zoomend = to_brr "zoomend" +end + +let of_jv_t = Fun.id + +let to_jv_t = 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 fit_world map = ignore @@ Jv.call map "fitWorld" [||] + +let get_container map = + Jv.call (to_jv_t 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 as_target map = Brr.Ev.target_of_jv map + +let on ~event ~handler map = + let name = Brr.Ev.Type.name event |> Jv.of_jstr in + ignore @@ Jv.call map "on" [| name; Jv.repr handler |] + +let get_center map = Latlng.of_jv_t @@ 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 |] diff --git a/src/map.mli b/src/map.mli new file mode 100644 index 0000000..c373001 --- /dev/null +++ b/src/map.mli @@ -0,0 +1,34 @@ +type t + +module Event : sig + (* TODO do this need to be wrapped in Brr.Ev.type' ?*) + val click : Ev.Mouse.t Brr.Ev.type' + + val moveend : Ev.Event.t Brr.Ev.type' + + val zoomend : Ev.Event.t Brr.Ev.type' +end + +val create : ?options:Jv.t -> string -> t + +val invalidate_size : t -> unit + +val set_view : Latlng.t -> ?zoom:int -> t -> unit + +val fit_world : t -> unit + +val get_container : t -> Brr.El.t + +val on : event:'a Brr.Ev.type' -> handler:('a -> 'b) -> t -> unit + +val get_center : t -> Latlng.t + +val get_zoom : t -> int + +val wrapped_latlng : Latlng.t -> t -> Latlng.t + +val as_target : t -> Brr.Ev.target + +val of_jv_t : Jv.t -> t + +val to_jv_t : t -> Jv.t diff --git a/src/marker.ml b/src/marker.ml new file mode 100644 index 0000000..cfcd0b3 --- /dev/null +++ b/src/marker.ml @@ -0,0 +1,11 @@ +type t = Jv.t + +let create latlng = Jv.call Global.leaflet "marker" [| Latlng.to_jv_t latlng |] + +let add_to marker map = ignore @@ Jv.call marker "addTo" [| Map.to_jv_t map |] + +let bind_popup el marker = + ignore @@ Jv.call marker "bindPopup" [| Brr.El.to_jv el |]; + marker + +let open_popup marker = ignore @@ Jv.call marker "openPopup" [||] diff --git a/src/marker.mli b/src/marker.mli new file mode 100644 index 0000000..3bf1691 --- /dev/null +++ b/src/marker.mli @@ -0,0 +1,11 @@ +type t + +val create : Latlng.t -> t + +val add_to : t -> Map.t -> unit + +(** {2 Popup methods} *) + +val bind_popup : Brr.El.t -> t -> t + +val open_popup : t -> unit diff --git a/src/popup.ml b/src/popup.ml new file mode 100644 index 0000000..9a268db --- /dev/null +++ b/src/popup.ml @@ -0,0 +1,11 @@ +let popup = Jv.call Global.leaflet "popup" [||] + +let set_latlng latlng = + ignore @@ Jv.call popup "setLatLng" [| Latlng.to_jv_t latlng |] + +let set_content content = + ignore @@ Jv.call popup "setContent" [| Jv.of_string content |] + +let open_on map = ignore @@ Jv.call popup "openOn" [| Map.to_jv_t map |] + +let close map = ignore @@ Jv.call (Map.to_jv_t map) "closePopup" [||] diff --git a/src/popup.mli b/src/popup.mli new file mode 100644 index 0000000..cda85f6 --- /dev/null +++ b/src/popup.mli @@ -0,0 +1,7 @@ +val set_latlng : Latlng.t -> unit + +val set_content : string -> unit + +val open_on : Map.t -> unit + +val close : Map.t -> unit diff --git a/src/tile_layer.ml b/src/tile_layer.ml new file mode 100644 index 0000000..fe32d14 --- /dev/null +++ b/src/tile_layer.ml @@ -0,0 +1,16 @@ +type t = Jv.t + +let create_osm () = + Jv.call Global.leaflet "tileLayer" + [| Jv.of_string "https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png" + ; Jv.obj + [| ( "attribution" + , Jv.of_string + "© OpenStreetMap \ + contributors" ) + |] + |] + +let add_to tile_layer map = + ignore @@ Jv.call tile_layer "addTo" [| Map.to_jv_t map |] diff --git a/src/tile_layer.mli b/src/tile_layer.mli new file mode 100644 index 0000000..afcd56e --- /dev/null +++ b/src/tile_layer.mli @@ -0,0 +1,5 @@ +type t + +val create_osm : unit -> t + +val add_to : t -> Map.t -> unit