Allow to customize icons

1 files changed, 61 insertions, 0 deletions

diff --git a/src/View/Map/Marker.ml b/src/View/Map/Marker.ml
new file mode 100644
index 0000000..a96af86
--- /dev/null
+++ b/src/View/Map/Marker.ml
@@ -0,0 +1,61 @@
+let create on_remove on_update pos init_name init_color init_icon =
+  let marker =
+        Leaflet.marker pos
+          { title = init_name
+          ; icon = Icon.create init_icon init_color
+          ; draggable = true
+          }
+  in
+  let form on_remove on_update =
+    let name = ref init_name in
+    let color = ref init_color in
+    let icon = ref init_icon in
+    let on_update () =
+          let () = on_update pos pos !name !color !icon in
+          Modal.hide ()
+    in
+    H.div
+      [| |]
+      [| Layout.section
+          [| |]
+          [| H.form
+              [| HA.class_ "g-MarkerForm"
+              ;  HE.on_submit (fun e ->
+                  let () = Event.preventDefault e in
+                  on_update ())
+              |]
+              [| Form.section "Modification"
+              ;  Layout.section
+                  [| |]
+                  [| Form.input "g-MarkerForm__Name" "Name" init_name (fun newName -> name := newName)
+                  ;  Form.color_input "g-MarkerForm__Color" "Color" init_color (fun newColor -> color := newColor)
+                  ;  Autocomplete.create
+                      "g-MarkerForm__Icon"
+                      "Icon"
+                      FontAwesome.icons
+                      (fun newIcon -> let () = Js.log newIcon in icon := newIcon)
+                      [| HA.value init_icon |]
+                  |]
+              ;  Button.action (fun _ -> on_update ()) "Modify"
+              |]
+          |]
+      ;  Layout.section
+          [| |]
+          [| Form.section "Deletion"
+          ;  Button.danger (fun _ ->
+                let () = on_remove pos in
+                Modal.hide ()) "Remove"
+          |]
+      |]
+  in
+
+  (* Open a modification / deletion modal on click *)
+  let () = Leaflet.on marker "click" (fun _ ->
+    Modal.show (form on_remove on_update)) in
+
+  (* Move the cursor on drag *)
+  let () = Leaflet.on marker "dragend" (fun e ->
+    let newPos = Leaflet.get_lat_lng (Leaflet.target e) () in
+    on_update pos newPos init_name init_color init_icon) in
+
+  marker