From 081e6aae57719c15bdbc5e973ca7ddba9506a4bb Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 8 Aug 2020 12:49:03 +0200 Subject: Show context menu to add, modify and delete markers --- src/View/Map/Marker.ml | 111 +++++++++++++++++++++++++++---------------------- 1 file changed, 61 insertions(+), 50 deletions(-) (limited to 'src/View/Map/Marker.ml') 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 -- cgit v1.2.3