aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Lib/Dom/Element.ml3
-rw-r--r--src/Lib/Dom/Event.ml3
-rw-r--r--src/Lib/Dom/HE.ml2
-rw-r--r--src/View/Button.ml8
-rw-r--r--src/View/Form.ml7
-rw-r--r--src/View/Form/Autocomplete.ml62
-rw-r--r--src/View/Map.ml4
-rw-r--r--src/View/Map/Marker.ml17
8 files changed, 66 insertions, 40 deletions
diff --git a/src/Lib/Dom/Element.ml b/src/Lib/Dom/Element.ml
index e370cf5..feb6003 100644
--- a/src/Lib/Dom/Element.ml
+++ b/src/Lib/Dom/Element.ml
@@ -46,3 +46,6 @@ let mount_on base element =
external files : Dom.element -> string Js.Array.t = "files"
[@@bs.get]
+
+external focus : Dom.element -> unit = "focus"
+ [@@bs.send]
diff --git a/src/Lib/Dom/Event.ml b/src/Lib/Dom/Event.ml
index 9db46f0..5a9790f 100644
--- a/src/Lib/Dom/Event.ml
+++ b/src/Lib/Dom/Event.ml
@@ -7,6 +7,9 @@ external stop_propagation : Dom.event -> unit = "stopPropagation"
external target : Dom.event -> Dom.element = "target"
[@@bs.get]
+external related_target : Dom.event -> Dom.element Js.Nullable.t = "relatedTarget"
+ [@@bs.get]
+
external page_x : Dom.mouseEvent -> float = "pageX"
[@@bs.get]
diff --git a/src/Lib/Dom/HE.ml b/src/Lib/Dom/HE.ml
index 6e658ce..03d2386 100644
--- a/src/Lib/Dom/HE.ml
+++ b/src/Lib/Dom/HE.ml
@@ -9,3 +9,5 @@ let on_submit f = H.EventAttr ("submit", f)
let on_blur f = H.EventAttr ("blur", f)
let on_change f = H.EventAttr ("change", f)
+
+let on_focus f = H.EventAttr ("focus", f)
diff --git a/src/View/Button.ml b/src/View/Button.ml
index 723b7d1..b4641d2 100644
--- a/src/View/Button.ml
+++ b/src/View/Button.ml
@@ -1,19 +1,19 @@
let raw attrs content =
H.button
- (HA.concat attrs [| HA.class_ "g-Button__Raw" |])
+ (HA.concat [| HA.class_ "g-Button__Raw" |] attrs)
content
let text attrs content =
H.button
- (HA.concat attrs [| HA.class_ "g-Button__Text" |])
+ (HA.concat [| HA.class_ "g-Button__Text" |] attrs)
content
let action attrs content =
H.button
- (HA.concat attrs [| HA.class_ "g-Button__Action" |])
+ (HA.concat [| HA.class_ "g-Button__Action" |] attrs)
content
let cancel attrs content =
H.button
- (HA.concat attrs [| HA.class_ "g-Button__Cancel" |])
+ (HA.concat [| HA.class_ "g-Button__Cancel" |] attrs)
content
diff --git a/src/View/Form.ml b/src/View/Form.ml
index 53fbb7d..cec49d6 100644
--- a/src/View/Form.ml
+++ b/src/View/Form.ml
@@ -1,4 +1,4 @@
-let input id label init_value on_input =
+let input id label attrs =
H.div
[| HA.class_ "g-Form__Field" |]
[| H.div
@@ -8,10 +8,7 @@ let input id label init_value on_input =
[| H.text label |]
|]
; H.input
- [| HA.id id
- ; HE.on_input (fun e -> on_input (Element.value (Event.target e)))
- ; HA.value init_value
- |]
+ (HA.concat attrs [| HA.id id |])
[| |]
|]
diff --git a/src/View/Form/Autocomplete.ml b/src/View/Form/Autocomplete.ml
index 2770e16..98e4b43 100644
--- a/src/View/Form/Autocomplete.ml
+++ b/src/View/Form/Autocomplete.ml
@@ -1,6 +1,5 @@
let search s xs =
- let results = Js.Array.filter (Js.String.includes s) xs in
- if Js.Array.length results == 1 && results.(0) == s then [| |] else results
+ Js.Array.filter (Js.String.includes s) xs
let render_completion render_entry on_select entries =
H.div
@@ -38,29 +37,44 @@ let create attrs id values render_entry on_input =
Element.mount_on completion (H.text "")
in
+ let
+ input =
+ H.input
+ (HA.concat
+ attrs
+ [| HA.id id
+ ; HA.class_ "g-Autocomplete__Input"
+ ; HA.autocomplete "off"
+ ; HE.on_focus (fun e ->
+ let target = Event.target e in
+ let value = Element.value target in
+ update_completion target value)
+ ; HE.on_input (fun e ->
+ let target = Event.target e in
+ let value = Element.value target in
+ let () = update_completion target value in
+ on_input value)
+ |])
+ [| |]
+ in
+
+ let () =
+ Element.add_event_listener input "blur" (fun e ->
+ if Js.isNullable (Event.related_target e) then
+ hide_completion ())
+ in
+
H.div
[| HA.class_ "g-Autocomplete" |]
- [| H.input
- (HA.concat
- attrs
- [| HA.id id
- ; HA.class_ "g-Autocomplete__Input"
- ; HA.autocomplete "off"
- ; HE.on_click (fun e ->
- let target = Event.target e in
- let value = Element.value target in
- update_completion target value)
- ; HE.on_input (fun e ->
- let target = Event.target e in
- let value = Element.value target in
- let () = update_completion target value in
- on_input value)
- ; HE.on_blur (fun _ ->
- let _ = Js.Global.setTimeout
- (fun _ -> hide_completion ())
- 100
- in ())
- |])
- [| |]
+ [| input
; completion
+ ; Button.raw
+ [| HA.class_ "g-Autocomplete__Clear fa fa-close"
+ ; HA.type_ "button"
+ ; HE.on_click (fun _ ->
+ let () = on_input "" in
+ let () = Element.set_value input "" in
+ Element.focus input)
+ |]
+ [| |]
|]
diff --git a/src/View/Map.ml b/src/View/Map.ml
index c85a791..6e2611e 100644
--- a/src/View/Map.ml
+++ b/src/View/Map.ml
@@ -46,7 +46,7 @@ let mapView state map markers =
|]
[| H.text "Map" |]
; Layout.line
- [| |]
+ [| HA.class_ "g-Layout__HeaderImportExport" |]
[| H.input
[| HA.id "g-Header__ImportInput"
; HA.type_ "file"
@@ -68,7 +68,7 @@ let mapView state map markers =
[| |]
; H.label
[| HA.for_ "g-Header__ImportInput"
- ; HA.class_ "g-Header__ImportLabel"
+ ; HA.class_ "g-Button__Text"
|]
[| H.text "Import" |]
; Button.text
diff --git a/src/View/Map/Marker.ml b/src/View/Map/Marker.ml
index c628c3a..1c0c0d6 100644
--- a/src/View/Map/Marker.ml
+++ b/src/View/Map/Marker.ml
@@ -18,7 +18,12 @@ let form on_validate colors init_name init_color init_icon =
|]
[| Layout.section
[| |]
- [| Form.input "g-MarkerForm__Name" "Name" init_name (fun newName -> name := newName)
+ [| Form.input
+ "g-MarkerForm__Name"
+ "Name"
+ [| HE.on_input (fun e -> name := (Element.value (Event.target e)))
+ ; HA.value init_name
+ |]
; Form.color_input colors "g-MarkerForm__Color" "Color" init_color (fun newColor -> color := newColor)
; H.div
[| HA.class_ "g-Form__Field" |]
@@ -30,10 +35,11 @@ let form on_validate colors init_name init_color init_icon =
|]
; let dom_icon = H.div [| HA.class_ ("fa fa-" ^ !icon) |] [| |] in
Layout.line
- [| |]
- [| H.div [| HA.class_ "g-MarkerForm__Icon" |] [| dom_icon |]
- ; Autocomplete.create
- [| HA.value init_icon |]
+ [| HA.class_ "g-MarkerForm__AutocompleteAndIcon" |]
+ [| Autocomplete.create
+ [| HA.value init_icon
+ ; HA.class_ "g-MarkerForm__Autocomplete"
+ |]
"g-MarkerForm__IconInput"
FontAwesome.icons
(fun icon ->
@@ -45,6 +51,7 @@ let form on_validate colors init_name init_color init_icon =
(fun newIcon ->
let () = icon := newIcon in
Element.set_class_name dom_icon ("fa fa-" ^ newIcon))
+ ; H.div [| HA.class_ "g-MarkerForm__Icon" |] [| dom_icon |]
|]
|]
|]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 14:05:38 +0000