Show context menu to add, modify and delete markers

7 files changed, 100 insertions, 109 deletions

diff --git a/src/View/Button.ml b/src/View/Button.ml
index 31fa1b0..c325fdd 100644
--- a/src/View/Button.ml
+++ b/src/View/Button.ml
@@ -1,13 +1,9 @@
-let action on_click label =
+let action attrs content =
   H.button
-      [| HA.class_ "g-Button__Action"
-      ;  HE.on_click on_click
-      |]
-      [| H.text label |]
+    (Js.Array.concat attrs [| HA.class_ "g-Button__Action" |])
+    content
 
-let danger on_click label =
-      H.button
-          [| HA.class_ "g-Button__Danger"
-          ;  HE.on_click on_click
-          |]
-          [| H.text label |]
+let cancel attrs content =
+  H.button
+    (Js.Array.concat attrs [| HA.class_ "g-Button__Cancel" |])
+    content
diff --git a/src/View/Form.ml b/src/View/Form.ml
index b0319b5..db73b0c 100644
--- a/src/View/Form.ml
+++ b/src/View/Form.ml
@@ -1,8 +1,3 @@
-let section name =
-  H.h1
-    [| HA.class_ "g-Form__Section" |]
-    [| H.text name |]
-
 let input id label init_value on_input =
   H.div
     [| HA.class_ "g-Form__Field" |]
diff --git a/src/View/Layout.ml b/src/View/Layout.ml
index 98218ad..b217f0b 100644
--- a/src/View/Layout.ml
+++ b/src/View/Layout.ml
@@ -2,3 +2,8 @@ let section attrs content =
   H.div
     (Js.Array.concat [| HA.class_ "g-Layout__Section" |] attrs)
     content
+
+let line attrs content =
+  H.div
+    (Js.Array.concat [| HA.class_ "g-Layout__Line" |] attrs)
+    content
diff --git a/src/View/Map.ml b/src/View/Map.ml
index 969a95a..b46557d 100644
--- a/src/View/Map.ml
+++ b/src/View/Map.ml
@@ -66,21 +66,32 @@ let installMap () =
   let () = reload_from_hash true in
 
   (* Reload the map if the URL changes *)
-  let () = Element.addEventListener Window.window "popstate" (fun _ ->
+  let () = Element.add_event_listener Window.window "popstate" (fun _ ->
     reload_from_hash true)
   in
 
-  (* Add a marker on right click *)
-  Leaflet.on map "contextmenu" (fun (event) ->
-    let pos = Leaflet.lat_lng event in
-    let new_marker =
-      match State.last_added !state with
-      | Some m -> { m with pos = pos; name = "" }
-      | None -> { pos = pos; name = ""; color = "#3f92cf"; icon = "" }
-    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_string new_state) () in
-    reload_from_hash false)
+    reload_from_hash 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
+             Modal.show (Marker.form (add_marker pos) marker.name marker.color marker.icon))
+         }
+      |])
 
 let render () =
   let _ = Js.Global.setTimeout installMap 0 in
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
diff --git a/src/View/Modal.ml b/src/View/Modal.ml
deleted file mode 100644
index 9365555..0000000
--- a/src/View/Modal.ml
+++ /dev/null
@@ -1,27 +0,0 @@
-let hide () =
-  let body = Document.querySelectorUnsafe "body" in
-  let modal = Document.querySelectorUnsafe ".g-Modal" in
-  Element.removeChild body modal
-
-let show content =
-  let body = Document.querySelectorUnsafe "body" in
-  let view =
-    H.div
-      [| HA.class_ "g-Modal" |]
-      [| H.div
-          [| HA.class_ "g-Modal__Curtain"
-          ;  HE.on_click (fun _ -> hide ())
-          |]
-          [| |]
-      ;  H.div
-          [| HA.class_ "g-Modal__Window" |]
-          [| H.button
-              [| HA.class_ "g-Modal__Close"
-              ;  HE.on_click (fun _ -> hide ())
-              |]
-              [| H.text "X" |]
-          ;  content
-          |]
-      |]
-  in
-  Element.appendChild body view