blob: 6e2611e1d4daad1acc502ae292b07302b195f3dc (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
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
|
