let state_from_hash () = let hash = Js.String.sliceToEnd ~from:1 (Location.hash Document.location) in State.from_url_string hash let rec reload_from_hash state map markers focus = let update_state new_state = let () = History.push_state "" "" ("#" ^ State.to_url_string new_state) () in reload_from_hash state map markers false in let on_remove pos = update_state (State.remove !state pos) in let on_update previousPos pos name color icon = update_state (State.update !state previousPos { pos = pos; name = name; color = color; icon = icon }) in let () = if Js.Array.length (Leaflet.get_layers markers ()) > 0 then Leaflet.clear_layers markers else () in let () = state := state_from_hash () in let colors = State.colors !state in let () = Js.Array.forEach (fun (m: State.marker_state) -> Leaflet.add_layer markers (Marker.create on_remove on_update colors m.pos m.name m.color m.icon)) !state in if focus then if Js.Array.length (Leaflet.get_layers markers ()) > 0 then Leaflet.fit_bounds map (Leaflet.get_bounds markers ()) { padding = [| 50.; 50. |] } else Leaflet.setView map [| 51.505; -0.09 |] 2 else () let mapView state map markers = H.div [| HA.class_ "g-Layout__Page" |] [| H.div [| HA.class_ "g-Layout__Header" |] [| H.a [| HA.class_ "g-Layout__Home" ; HA.href "#" |] [| H.text "Map" |] ; Layout.line [| HA.class_ "g-Layout__HeaderImportExport" |] [| H.input [| HA.id "g-Header__ImportInput" ; HA.type_ "file" ; HE.on_change (fun e -> match !map with | Some map -> let reader = File.reader () in let () = Element.add_event_listener reader "load" (fun _ -> let str = File.result reader in let new_state = State.from_dicts (CSV.to_dicts (CSV.parse str)) in let () = History.push_state "" "" ("#" ^ State.to_url_string new_state) () in reload_from_hash state map markers true) in File.read_as_text reader ( Js.Array.unsafe_get (Element.files (Event.target e)) 0) | _ -> ()) |] [| |] ; H.label [| HA.for_ "g-Header__ImportInput" ; HA.class_ "g-Button__Text" |] [| H.text "Import" |] ; Button.text [| HE.on_click (fun _ -> File.download "map.csv" (State.to_csv_string !state)) |] [| H.text "Export" |] |] |] ; H.div [| HA.class_ "g-Map" |] [| H.div [| HA.id "g-Map__Content" |] [||] |] |] let install_map state map_ref markers = let map = Leaflet.map "g-Map__Content" { attributionControl = false } in let () = map_ref := Some map in let title_layer = Leaflet.title_layer "http://{s}.tile.osm.org/{z}/{x}/{y}.png" in let () = Leaflet.add_layer map markers in let () = Leaflet.add_layer map title_layer in (* Init markers from url *) let () = reload_from_hash state map markers true in (* Reload the map if the URL changes *) let () = Element.add_event_listener Window.window "popstate" (fun _ -> reload_from_hash state map markers true) in let add_marker pos name color icon = let new_marker = { State.pos = pos; name = name; color = color; icon = icon } in let new_state = State.update !state pos new_marker in let () = History.push_state "" "" ("#" ^ State.to_url_string new_state) () in reload_from_hash state map markers false in (* Context menu *) Leaflet.on map "contextmenu" (fun event -> ContextMenu.show (Leaflet.original_event event) [| { label = "Add a marker" ; action = (fun _ -> let pos = Leaflet.lat_lng event in let marker = match State.last_added !state with | Some m -> { m with pos = pos; name = "" } | _ -> { pos = pos; name = ""; color = "#3f92cf"; icon = "" } in let colors = State.colors !state in Modal.show (Marker.form (add_marker pos) colors marker.name marker.color marker.icon)) } |]) let render () = let state = ref (state_from_hash ()) in let map = ref None in let markers = Leaflet.feature_group [| |] in let _ = Js.Global.setTimeout (fun _ -> install_map state map markers) 0 in mapView state map markers