aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--public/main.css1
-rw-r--r--src/Lib/Dom/Element.ml3
-rw-r--r--src/Lib/Dom/HA.ml2
-rw-r--r--src/Lib/File.ml12
-rw-r--r--src/Lib/Fun.ml2
-rw-r--r--src/Lib/URI.ml2
-rw-r--r--src/State.ml23
-rw-r--r--src/View/Form.ml2
-rw-r--r--src/View/Map.ml19
9 files changed, 54 insertions, 12 deletions
diff --git a/public/main.css b/public/main.css
index 9b94186..fdedc4c 100644
--- a/public/main.css
+++ b/public/main.css
@@ -19,6 +19,7 @@ body {
.g-Layout__Header {
display: flex;
align-items: center;
+ justify-content: space-between;
width: 100%;
background-color: var(--color-header);
color: white;
diff --git a/src/Lib/Dom/Element.ml b/src/Lib/Dom/Element.ml
index 3c63ef4..90c0321 100644
--- a/src/Lib/Dom/Element.ml
+++ b/src/Lib/Dom/Element.ml
@@ -27,6 +27,9 @@ external first_child : Dom.element -> Dom.element Js.Nullable.t = "firstChild"
external remove_child : Dom.element -> Dom.element -> unit = "removeChild"
[@@bs.send]
+external click : Dom.element -> unit = "click"
+ [@@bs.send]
+
let remove_first_child element =
match Js.toOption (first_child element) with
| Some child ->
diff --git a/src/Lib/Dom/HA.ml b/src/Lib/Dom/HA.ml
index 53fb84d..ce02f2a 100644
--- a/src/Lib/Dom/HA.ml
+++ b/src/Lib/Dom/HA.ml
@@ -39,3 +39,5 @@ let style v = H.TextAttr ("style", v)
let href v = H.TextAttr ("href", v)
let autocomplete v = H.TextAttr ("autocomplete", v)
+
+let download v = H.TextAttr ("download", v)
diff --git a/src/Lib/File.ml b/src/Lib/File.ml
new file mode 100644
index 0000000..0089001
--- /dev/null
+++ b/src/Lib/File.ml
@@ -0,0 +1,12 @@
+let download filename content =
+ let a =
+ H.a
+ [| HA.href ("data:text/plain;charset=utf-8," ^ URI.encode content)
+ ; HA.download filename
+ ; HA.style "display:none"
+ |]
+ [| |]
+ in
+ let () = Element.append_child Document.body a in
+ let () = Element.click a in
+ Element.remove_child Document.body a
diff --git a/src/Lib/Fun.ml b/src/Lib/Fun.ml
new file mode 100644
index 0000000..bf1eb38
--- /dev/null
+++ b/src/Lib/Fun.ml
@@ -0,0 +1,2 @@
+let flip f b a =
+ f a b
diff --git a/src/Lib/URI.ml b/src/Lib/URI.ml
new file mode 100644
index 0000000..705bc7b
--- /dev/null
+++ b/src/Lib/URI.ml
@@ -0,0 +1,2 @@
+external encode : string -> string = "encodeURIComponent"
+ [@@bs.val]
diff --git a/src/State.ml b/src/State.ml
index 59391d2..4c6cedb 100644
--- a/src/State.ml
+++ b/src/State.ml
@@ -17,7 +17,7 @@ let last_added state =
else
None
-(* Serialization *)
+(* URL Serialization *)
let sep = "|"
@@ -30,13 +30,13 @@ let marker_to_string marker =
|]
|> Js.Array.joinWith sep
-let to_string state =
+let to_url_string state =
state
|> Js.Array.map marker_to_string
|> Js.Array.joinWith sep
|> String.encode
-let from_string str =
+let from_url_string str =
let (_, _, res) = Js.Array.reduce
(fun (acc_str, acc_marker, acc_state) c ->
let length = Js.Array.length acc_marker in
@@ -60,6 +60,23 @@ let from_string str =
(Js.Array.from (Js.String.castToArrayLike ((String.decode str) ^ sep)))
in res
+(* CSV Serialization *)
+
+let to_csv_line marker =
+ [| Js.Float.toString marker.pos.lat
+ ; Js.Float.toString marker.pos.lng
+ ; marker.name
+ ; marker.color
+ ; marker.icon
+ |]
+ |> Js.Array.joinWith ","
+
+let to_csv_string state =
+ state
+ |> Js.Array.map to_csv_line
+ |> Fun.flip Js.Array.concat [| "lat,lng,name,color,icon" |]
+ |> Js.Array.joinWith "\n"
+
(* Colors *)
let colors =
diff --git a/src/View/Form.ml b/src/View/Form.ml
index cc95210..53fbb7d 100644
--- a/src/View/Form.ml
+++ b/src/View/Form.ml
@@ -47,7 +47,7 @@ let color_input default_colors id label init_value on_input =
; HA.type_ "button"
|]
[| |])
- |> (fun xs -> Js.Array.concat xs [| input |]))
+ |> Fun.flip Js.Array.concat [| input |])
|]
let textarea id label init_value on_input =
diff --git a/src/View/Map.ml b/src/View/Map.ml
index eda934c..8f74b76 100644
--- a/src/View/Map.ml
+++ b/src/View/Map.ml
@@ -1,4 +1,4 @@
-let mapView =
+let mapView state =
H.div
[| HA.class_ "g-Layout__Page" |]
[| H.div
@@ -8,6 +8,9 @@ let mapView =
; HA.href "#"
|]
[| H.text "Map" |]
+ ; Button.text
+ [| HE.on_click (fun _ -> File.download "map.csv" (State.to_csv_string !state)) |]
+ [| H.text "Export" |]
|]
; H.div
[| HA.class_ "g-Map" |]
@@ -19,10 +22,9 @@ let mapView =
let state_from_hash () =
let hash = Js.String.sliceToEnd ~from:1 (Location.hash Document.location) in
- State.from_string hash
+ State.from_url_string hash
-let installMap () =
- let state = ref (state_from_hash ()) in
+let installMap state =
let map = Leaflet.map "g-Map__Content" in
let title_layer = Leaflet.title_layer "http://{s}.tile.osm.org/{z}/{x}/{y}.png" in
let markers = Leaflet.feature_group [| |] in
@@ -31,7 +33,7 @@ let installMap () =
let rec reload_from_hash focus =
let update_state new_state =
- let () = History.push_state "" "" ("#" ^ State.to_string new_state) () in
+ let () = History.push_state "" "" ("#" ^ State.to_url_string new_state) () in
reload_from_hash false
in
@@ -74,7 +76,7 @@ let installMap () =
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_string new_state) () in
+ let () = History.push_state "" "" ("#" ^ State.to_url_string new_state) () in
reload_from_hash false
in
@@ -96,5 +98,6 @@ let installMap () =
|])
let render () =
- let _ = Js.Global.setTimeout installMap 0 in
- mapView
+ let state = ref (state_from_hash ()) in
+ let _ = Js.Global.setTimeout (fun _ -> installMap state) 0 in
+ mapView state
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 13:11:43 +0000