Allow to customize icons

3 files changed, 93 insertions, 0 deletions

diff --git a/src/View/Map/Icon.ml b/src/View/Map/Icon.ml
new file mode 100644
index 0000000..9b1f40a
--- /dev/null
+++ b/src/View/Map/Icon.ml
@@ -0,0 +1,32 @@
+let create name color =
+  let c = Color.from_raw color in
+  let crBlack = Color.contrast_ratio { r = 0.; g = 0.; b = 0. } c in
+  let crWhite = Color.contrast_ratio { r = 255.; g = 255.; b = 255. } c in
+  let textCol = if crBlack > crWhite then "black" else "white" in
+  Leaflet.div_icon
+    { className = "marker-parent"
+    ; popupAnchor = [| 0.; -34. |]
+    ; html =
+        H.div
+          [| |]
+          [| H.div
+              [| HA.class_ "marker-round"
+              ;  HA.style ("background-color: " ^ color)
+              |]
+              [| |]
+          ;  H.div [| HA.class_ "marker-peak-border" |] [| |]
+          ;  H.div
+              [| HA.class_ "marker-peak-inner"
+              ;  HA.style ("border-top-color: " ^ color)
+              |]
+              [| |]
+          ;  H.div
+              [| HA.class_ "marker-icon" |]
+              [| H.i
+                  [| HA.class_ ("fa fa-" ^ name)
+                  ;  HA.style ("color: " ^ textCol)
+                  |]
+                  [| |]
+              |]
+          |]
+    }
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
diff --git a/src/View/Map/MarkerForm.ml b/src/View/Map/MarkerForm.ml
deleted file mode 100644
index e69de29..0000000
--- a/src/View/Map/MarkerForm.ml
+++ /dev/null