kumikode/leaflet
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

split modules and fix Ev

Browse source
This commit is contained in:
Swrup 2022-04-07 14:45:11 +02:00
parent 7973527757
commit 982a1f295b
18 changed files with 208 additions and 225 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/dune
View file

@ -1,7 +1,7 @@
(library (library
(name leaflet) (name leaflet)
(public_name leaflet) (public_name leaflet)
(modules leaflet) (modules ev latlng geojson_layer tile_layer popup marker map global)
(libraries brr js_of_ocaml) (libraries brr js_of_ocaml)
(js_of_ocaml (js_of_ocaml
(javascript_files leaflet.js))) (javascript_files leaflet.js)))

12
src/ev.ml Normal file
View file

@ -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

11
src/ev.mli Normal file
View file

@ -0,0 +1,11 @@
type type'
module Event : sig
type t
end
module Mouse : sig
type t
val latlng : t -> Latlng.t
end

7
src/geojson_layer.ml Normal file
View file

@ -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 |]

5
src/geojson_layer.mli Normal file
View file

@ -0,0 +1,5 @@
type t
val create : ?options:Jv.t -> Jv.t -> t
val add_to : t -> Map.t -> unit

4
src/global.ml Normal file
View file

@ -0,0 +1,4 @@
let leaflet =
match Jv.(find global "L") with
| Some l -> l
| None -> failwith "Could not load Leaflet"

14
src/latlng.ml Normal file
View file

@ -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

13
src/latlng.mli Normal file
View file

@ -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

121
src/leaflet.ml
View file

@ -1,121 +0,0 @@
(*
* SPDX-FileCopyrightText: 2021 pukkamustard <pukkamustard@posteo.net>
*
* 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
"&copy; <a \
href=\"https://www.openstreetmap.org/copyright\">OpenStreetMap</a> \
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

103
src/leaflet.mli
View file

@ -1,103 +0,0 @@
(*
* SPDX-FileCopyrightText: 2021 pukkamustard <pukkamustard@posteo.net>
*
* 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

46
src/map.ml Normal file
View file

@ -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 |]

34
src/map.mli Normal file
View file

@ -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

11
src/marker.ml Normal file
View file

@ -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" [||]

11
src/marker.mli Normal file
View file

@ -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

11
src/popup.ml Normal file
View file

@ -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" [||]

7
src/popup.mli Normal file
View file

@ -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

16
src/tile_layer.ml Normal file
View file

@ -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
"&copy; <a \
href=\"https://www.openstreetmap.org/copyright\">OpenStreetMap</a> \
contributors" )
|]
|]
let add_to tile_layer map =
ignore @@ Jv.call tile_layer "addTo" [| Map.to_jv_t map |]

5
src/tile_layer.mli Normal file
View file

@ -0,0 +1,5 @@
type t
val create_osm : unit -> t
val add_to : t -> Map.t -> unit