Show context menu to add, modify and delete markers

2 files changed, 67 insertions, 56 deletions

diff --git a/src/View/Map/Icon.ml b/src/View/Map/Icon.ml
index 9b1f40a..8737f43 100644
--- a/src/View/Map/Icon.ml
+++ b/src/View/Map/Icon.ml
@@ -4,24 +4,24 @@ let create name color =
   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"
+    { className = ""
     ; popupAnchor = [| 0.; -34. |]
     ; html =
         H.div
-          [| |]
+          [| HA.class_ "g-Marker" |]
           [| H.div
-              [| HA.class_ "marker-round"
+              [| HA.class_ "g-Marker__Round"
               ;  HA.style ("background-color: " ^ color)
               |]
               [| |]
-          ;  H.div [| HA.class_ "marker-peak-border" |] [| |]
+          ;  H.div [| HA.class_ "g-Marker__PeakBorder" |] [| |]
           ;  H.div
-              [| HA.class_ "marker-peak-inner"
+              [| HA.class_ "g-Marker__PeakInner"
               ;  HA.style ("border-top-color: " ^ color)
               |]
               [| |]
           ;  H.div
-              [| HA.class_ "marker-icon" |]
+              [| HA.class_ "g-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
index a96af86..58ec4bd 100644
--- a/src/View/Map/Marker.ml
+++ b/src/View/Map/Marker.ml
@@ -1,61 +1,72 @@
+let form on_validate init_name init_color init_icon =
+  let name = ref init_name in
+  let color = ref init_color in
+  let icon = ref init_icon in
+  let on_validate () =
+        let () = on_validate !name !color !icon in
+        Modal.hide ()
+  in
+  H.div
+    [| |]
+    [| Layout.section
+        [| |]
+        [| H.form
+            [| HA.class_ "g-MarkerForm"
+            ;  HE.on_submit (fun e ->
+                let () = Event.prevent_default e in
+                on_validate ())
+            |]
+            [| 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 |]
+                |]
+            ;  Layout.line
+                [| |]
+                [| Button.action
+                    [| HE.on_click (fun _ -> on_validate ()) |]
+                    [| H.text "Save" |]
+                ;  Button.cancel
+                    [| HE.on_click (fun _ -> Modal.hide ())
+                    ;  HA.type_ "button"
+                    |]
+                    [| H.text "Cancel" |]
+                |]
+            |]
+        |]
+    |]
+
+
 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"
-          |]
-      |]
+    Leaflet.marker pos
+      { title = init_name
+      ; icon = Icon.create init_icon init_color
+      ; draggable = true
+      }
   in
 
-  (* Open a modification / deletion modal on click *)
-  let () = Leaflet.on marker "click" (fun _ ->
-    Modal.show (form on_remove on_update)) in
+  (* Context menu *)
+  let () = Leaflet.on marker "contextmenu" (fun event ->
+    ContextMenu.show
+      (Leaflet.original_event event)
+      [| { label = "Modify"; action = fun _ -> Modal.show (form (on_update pos pos) init_name init_color init_icon) }
+      ;  { label = "Remove"; action = fun _ -> on_remove pos }
+      |])
+  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
 
+  let () = Leaflet.on marker "dblclick" (fun _ ->
+    Modal.show (form (on_update pos pos) init_name init_color init_icon)) in
+
   marker