diff options
author | Joris | 2022-07-05 21:55:41 +0200 |
---|---|---|
committer | Joris | 2023-01-28 09:35:55 +0100 |
commit | 063d8ef9eaf874a941f4459e831057dd0a1b7ddd (patch) | |
tree | c4a8b27cb8fdb5d1dc26c560c7483c9593f40dac /src/View/Map.ml | |
parent | 2936f06576997bffe7903ea840df563a408efc21 (diff) |
Rewrite in TSmain
Diffstat (limited to 'src/View/Map.ml')
-rw-r--r-- | src/View/Map.ml | 131 |
1 files changed, 0 insertions, 131 deletions
diff --git a/src/View/Map.ml b/src/View/Map.ml deleted file mode 100644 index 6e2611e..0000000 --- a/src/View/Map.ml +++ /dev/null @@ -1,131 +0,0 @@ -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 |