|
|
|
@ -1,101 +1,68 @@ |
|
|
|
let log = Format.printf |
|
|
|
|
|
|
|
module Leaflet = struct |
|
|
|
(* get the leaflet object *) |
|
|
|
let leaflet = |
|
|
|
match Jv.(find global "L") with |
|
|
|
| Some l -> l |
|
|
|
| None -> failwith "can't load leaflet" |
|
|
|
let map = Leaflet.Map.create_on "map" |
|
|
|
|
|
|
|
(* get popup object *) |
|
|
|
let popup = Jv.call leaflet "popup" [||] |
|
|
|
let () = |
|
|
|
let osm_layer = Leaflet.Layer.create_tile_osm None in |
|
|
|
Leaflet.Layer.add_to map osm_layer |
|
|
|
|
|
|
|
(* create a map *) |
|
|
|
let map = |
|
|
|
log "creating map@\n"; |
|
|
|
let open Brr in |
|
|
|
let _container = El.div ~at:At.[ id (Jstr.v "map") ] [] in |
|
|
|
Jv.call leaflet "map" [| Jv.of_string "map" |] |
|
|
|
let storage = Brr_io.Storage.local Brr.G.window |
|
|
|
|
|
|
|
(* create map tile layer *) |
|
|
|
let tile_layer = |
|
|
|
log "creating tile layer@\n"; |
|
|
|
Jv.call leaflet "tileLayer" |
|
|
|
[| Jv.of_string "https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png" |
|
|
|
; Jv.obj |
|
|
|
[| ( "attribution" |
|
|
|
, Jv.of_string |
|
|
|
{|© <a href="https://.www.openstreetmap.org/copyright">OpenStreetMap</a> contributors|} |
|
|
|
) |
|
|
|
|] |
|
|
|
|] |
|
|
|
(* set map's view *) |
|
|
|
(* try to set map's view to last position viewed by using web storage *) |
|
|
|
let () = |
|
|
|
log "setting view@\n"; |
|
|
|
let lat = Brr_io.Storage.get_item storage (Jstr.of_string "lat") in |
|
|
|
let lng = Brr_io.Storage.get_item storage (Jstr.of_string "lng") in |
|
|
|
let zoom = Brr_io.Storage.get_item storage (Jstr.of_string "zoom") in |
|
|
|
match (lat, lng, zoom) with |
|
|
|
| Some lat, Some lng, Some zoom -> |
|
|
|
let lat = Jstr.to_float lat in |
|
|
|
let lng = Jstr.to_float lng in |
|
|
|
let zoom = |
|
|
|
match Jstr.to_int zoom with |
|
|
|
| None -> failwith "view storage bug" |
|
|
|
| Some zoom -> Some zoom |
|
|
|
in |
|
|
|
let latlng = Leaflet.Latlng.create lat lng in |
|
|
|
ignore @@ Leaflet.Map.set_view latlng ~zoom map |
|
|
|
| _ -> |
|
|
|
let latlng = Leaflet.Latlng.create 51.505 (-0.09) in |
|
|
|
ignore @@ Leaflet.Map.set_view latlng ~zoom:(Some 13) map |
|
|
|
|
|
|
|
(* add tile layer *) |
|
|
|
let () = |
|
|
|
log "adding tile layer@\n"; |
|
|
|
let _map : Jv.t = Jv.call tile_layer "addTo" [| map |] in |
|
|
|
() |
|
|
|
|
|
|
|
let storage = Brr_io.Storage.local Brr.G.window |
|
|
|
|
|
|
|
(* set map's view *) |
|
|
|
(* try to set map's view to last position viewed by using web storage *) |
|
|
|
let () = |
|
|
|
log "setting view@\n"; |
|
|
|
let lat = Brr_io.Storage.get_item storage (Jstr.of_string "lat") in |
|
|
|
let lng = Brr_io.Storage.get_item storage (Jstr.of_string "lng") in |
|
|
|
let zoom = Brr_io.Storage.get_item storage (Jstr.of_string "zoom") in |
|
|
|
match (lat, lng, zoom) with |
|
|
|
| Some lat, Some lng, Some zoom -> |
|
|
|
let latlng = |
|
|
|
Jv.call leaflet "latLng" [| Jv.of_jstr lat; Jv.of_jstr lng |] |
|
|
|
in |
|
|
|
ignore @@ Jv.call map "setView" [| latlng; Jv.of_jstr zoom |] |
|
|
|
| _ -> |
|
|
|
let latlng = |
|
|
|
Jv.call leaflet "latLng" [| Jv.of_float 51.505; Jv.of_float (-0.09) |] |
|
|
|
in |
|
|
|
ignore @@ Jv.call map "setView" [| latlng; Jv.of_int 13 |] |
|
|
|
|
|
|
|
let on_moveend _event = |
|
|
|
log "on moveend event@\n"; |
|
|
|
let latlng = Jv.call map "getCenter" [||] in |
|
|
|
(*we need to wrap coordinates so we don't drift into a parralel universe and lose track of markers :^) *) |
|
|
|
let wrapped_latlng = Jv.call map "wrapLatLng" [| latlng |] in |
|
|
|
let lat = Jv.get wrapped_latlng "lat" in |
|
|
|
let lng = Jv.get wrapped_latlng "lng" in |
|
|
|
match |
|
|
|
Brr_io.Storage.set_item storage (Jstr.of_string "lat") (Jv.to_jstr lat) |
|
|
|
with |
|
|
|
let on_moveend _event = |
|
|
|
log "on moveend event@\n"; |
|
|
|
let latlng = Leaflet.Map.get_center map in |
|
|
|
(*we need to wrap coordinates so we don't drift into a parralel universe and lose track of markers :^) *) |
|
|
|
let wrapped_latlng = Leaflet.Map.wrap_latlng latlng map in |
|
|
|
let lat = Leaflet.Latlng.lat latlng |> Jv.of_float |> Jv.to_jstr in |
|
|
|
let lng = Leaflet.Latlng.lng latlng |> Jv.of_float |> Jv.to_jstr in |
|
|
|
match Brr_io.Storage.set_item storage (Jstr.of_string "lat") lat with |
|
|
|
| (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" |
|
|
|
| Ok () -> ( |
|
|
|
match Brr_io.Storage.set_item storage (Jstr.of_string "lng") lng with |
|
|
|
| (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" |
|
|
|
| Ok () -> ( |
|
|
|
match |
|
|
|
Brr_io.Storage.set_item storage (Jstr.of_string "lng") (Jv.to_jstr lng) |
|
|
|
with |
|
|
|
| (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" |
|
|
|
| Ok () -> |
|
|
|
let is_wrapped = |
|
|
|
not @@ Jv.to_bool @@ Jv.call latlng "equals" [| wrapped_latlng |] |
|
|
|
in |
|
|
|
if is_wrapped then ( |
|
|
|
log "setView to wrapped coordinate@\n"; |
|
|
|
(* warning: calling setView in on_moveend can cause recursion *) |
|
|
|
ignore @@ Jv.call map "setView" [| wrapped_latlng |] ) ) |
|
|
|
| Ok () -> |
|
|
|
let is_wrapped = not @@ Leaflet.Latlng.equals latlng wrapped_latlng in |
|
|
|
if is_wrapped then ( |
|
|
|
log "setView to wrapped coordinate@\n"; |
|
|
|
(* warning: calling setView in on_moveend can cause recursion *) |
|
|
|
Leaflet.Map.set_view wrapped_latlng ~zoom:None map ) ) |
|
|
|
|
|
|
|
let on_zoomend _event = |
|
|
|
log "on zoomend event@\n"; |
|
|
|
let zoom = Jv.call map "getZoom" [||] in |
|
|
|
match |
|
|
|
Brr_io.Storage.set_item storage (Jstr.of_string "zoom") (Jv.to_jstr zoom) |
|
|
|
with |
|
|
|
| (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" |
|
|
|
| Ok () -> () |
|
|
|
let on_zoomend _event = |
|
|
|
log "on zoomend event@\n"; |
|
|
|
let zoom = Leaflet.Map.get_zoom map in |
|
|
|
match |
|
|
|
Brr_io.Storage.set_item storage (Jstr.of_string "zoom") |
|
|
|
(Jv.to_jstr @@ Jv.of_int zoom) |
|
|
|
with |
|
|
|
| (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" |
|
|
|
| Ok () -> () |
|
|
|
|
|
|
|
let () = |
|
|
|
log "add on (move/zoom)end event@\n"; |
|
|
|
ignore @@ Jv.call map "on" [| Jv.of_string "moveend"; Jv.repr on_moveend |]; |
|
|
|
ignore @@ Jv.call map "on" [| Jv.of_string "zoomend"; Jv.repr on_zoomend |] |
|
|
|
end |
|
|
|
let () = |
|
|
|
log "add on (move/zoom)end event@\n"; |
|
|
|
Leaflet.Map.on Leaflet.Event.Move_end on_moveend map; |
|
|
|
Leaflet.Map.on Leaflet.Event.Zoom_end on_zoomend map |
|
|
|
|
|
|
|
module Geolocalize = struct |
|
|
|
let update_location geo = |
|
|
|
@ -105,10 +72,8 @@ module Geolocalize = struct |
|
|
|
| Ok geo -> |
|
|
|
let lat = Brr_io.Geolocation.Pos.latitude geo in |
|
|
|
let lng = Brr_io.Geolocation.Pos.longitude geo in |
|
|
|
let latlng = |
|
|
|
Jv.call Leaflet.leaflet "latLng" [| Jv.of_float lat; Jv.of_float lng |] |
|
|
|
in |
|
|
|
ignore @@ Jv.call Leaflet.map "setView" [| latlng; Jv.of_int 13 |] |
|
|
|
let latlng = Leaflet.Latlng.create lat lng in |
|
|
|
Leaflet.Map.set_view latlng ~zoom:(Some 13) map |
|
|
|
|
|
|
|
let geolocalize _ = |
|
|
|
log "geolocalize@\n"; |
|
|
|
|
