aboutsummaryrefslogtreecommitdiff
path: root/src/View/Map
diff options
context:
space:
mode:
Diffstat (limited to 'src/View/Map')
-rw-r--r--src/View/Map/Icon.ml32
-rw-r--r--src/View/Map/Marker.ml61
-rw-r--r--src/View/Map/MarkerForm.ml0
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