From 38e42723a916b7d5c2a15e514b3f3e6dcab398dd Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 8 Aug 2020 21:04:28 +0200 Subject: Propose already defined colors in the form --- src/View/Button.ml | 14 ++++++++++++-- src/View/Colors.ml | 4 ++++ src/View/Form.ml | 31 ++++++++++++++++++++++++------- src/View/Form/Autocomplete.ml | 8 ++++---- src/View/Layout.ml | 4 ++-- src/View/Map.ml | 9 +++++++-- src/View/Map/Marker.ml | 17 +++++++++++------ 7 files changed, 64 insertions(+), 23 deletions(-) create mode 100644 src/View/Colors.ml (limited to 'src/View') diff --git a/src/View/Button.ml b/src/View/Button.ml index c325fdd..723b7d1 100644 --- a/src/View/Button.ml +++ b/src/View/Button.ml @@ -1,9 +1,19 @@ +let raw attrs content = + H.button + (HA.concat attrs [| HA.class_ "g-Button__Raw" |]) + content + +let text attrs content = + H.button + (HA.concat attrs [| HA.class_ "g-Button__Text" |]) + content + let action attrs content = H.button - (Js.Array.concat attrs [| HA.class_ "g-Button__Action" |]) + (HA.concat attrs [| HA.class_ "g-Button__Action" |]) content let cancel attrs content = H.button - (Js.Array.concat attrs [| HA.class_ "g-Button__Cancel" |]) + (HA.concat attrs [| HA.class_ "g-Button__Cancel" |]) content diff --git a/src/View/Colors.ml b/src/View/Colors.ml new file mode 100644 index 0000000..380a01c --- /dev/null +++ b/src/View/Colors.ml @@ -0,0 +1,4 @@ +let content () = + H.div + [| |] + [| H.text "Colors" |] diff --git a/src/View/Form.ml b/src/View/Form.ml index db73b0c..cc95210 100644 --- a/src/View/Form.ml +++ b/src/View/Form.ml @@ -15,7 +15,17 @@ let input id label init_value on_input = [| |] |] -let color_input id label init_value on_input = +let color_input default_colors id label init_value on_input = + let + input = + H.input + [| HA.id id + ; HE.on_input (fun e -> on_input (Element.value (Event.target e))) + ; HA.value init_value + ; HA.type_ "color" + |] + [| |] + in H.div [| HA.class_ "g-Form__Field" |] [| H.div @@ -24,13 +34,20 @@ let color_input id label init_value on_input = [| HA.for_ id |] [| 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.type_ "color" - |] + ; Layout.line [| |] + (default_colors + |> Js.Array.map (fun color -> + Button.raw + [| HA.class_ "g-Form__DefaultColor" + ; HA.style ("background-color: " ^ color) + ; HE.on_click (fun _ -> + let () = Element.set_value input color in + on_input color) + ; HA.type_ "button" + |] + [| |]) + |> (fun xs -> Js.Array.concat xs [| input |])) |] let textarea id label init_value on_input = diff --git a/src/View/Form/Autocomplete.ml b/src/View/Form/Autocomplete.ml index 324a834..2770e16 100644 --- a/src/View/Form/Autocomplete.ml +++ b/src/View/Form/Autocomplete.ml @@ -7,7 +7,7 @@ let render_completion render_entry on_select entries = [| HA.class_ "g-Autocomplete__Completion" |] (entries |> Js.Array.map (fun c -> - H.button + Button.raw [| HA.class_ "g-Autocomplete__Entry" ; HA.type_ "button" ; HE.on_click (fun e -> @@ -41,7 +41,8 @@ let create attrs id values render_entry on_input = H.div [| HA.class_ "g-Autocomplete" |] [| H.input - (Js.Array.concat + (HA.concat + attrs [| HA.id id ; HA.class_ "g-Autocomplete__Input" ; HA.autocomplete "off" @@ -59,8 +60,7 @@ let create attrs id values render_entry on_input = (fun _ -> hide_completion ()) 100 in ()) - |] - attrs) + |]) [| |] ; completion |] diff --git a/src/View/Layout.ml b/src/View/Layout.ml index b217f0b..db1e234 100644 --- a/src/View/Layout.ml +++ b/src/View/Layout.ml @@ -1,9 +1,9 @@ let section attrs content = H.div - (Js.Array.concat [| HA.class_ "g-Layout__Section" |] attrs) + (HA.concat attrs [| HA.class_ "g-Layout__Section" |]) content let line attrs content = H.div - (Js.Array.concat [| HA.class_ "g-Layout__Line" |] attrs) + (HA.concat attrs [| HA.class_ "g-Layout__Line" |]) content diff --git a/src/View/Map.ml b/src/View/Map.ml index b46557d..678f5ae 100644 --- a/src/View/Map.ml +++ b/src/View/Map.ml @@ -8,6 +8,9 @@ let mapView = ; HA.href "#" |] [| H.text "Map" |] + ; Button.text + [| HE.on_click (fun _ -> Modal.show (Colors.content ())) |] + [| H.text "Colors" |] |] ; H.div [| HA.class_ "g-Map" |] @@ -48,9 +51,10 @@ let installMap () = () in let () = state := state_from_hash () in + let colors = State.colors !state in let () = Js.Array.forEach - (fun (m: State.marker_state) -> Leaflet.add_layer markers (Marker.create on_remove on_update m.pos m.name m.color m.icon)) + (fun (m: State.marker_state) -> Leaflet.add_layer markers (Marker.create on_remove on_update colors m.pos m.name m.color m.icon)) !state in if focus then @@ -89,7 +93,8 @@ let installMap () = | 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 colors = State.colors !state in + Modal.show (Marker.form (add_marker pos) colors marker.name marker.color marker.icon)) } |]) diff --git a/src/View/Map/Marker.ml b/src/View/Map/Marker.ml index e793742..80072af 100644 --- a/src/View/Map/Marker.ml +++ b/src/View/Map/Marker.ml @@ -1,4 +1,4 @@ -let form on_validate init_name init_color init_icon = +let form on_validate colors init_name init_color init_icon = let name = ref init_name in let color = ref init_color in let icon = ref init_icon in @@ -19,7 +19,7 @@ let form on_validate init_name init_color init_icon = [| 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) + ; Form.color_input colors "g-MarkerForm__Color" "Color" init_color (fun newColor -> color := newColor) ; H.div [| HA.class_ "g-Form__Field" |] [| H.div @@ -59,7 +59,7 @@ let form on_validate init_name init_color init_icon = |] -let create on_remove on_update pos init_name init_color init_icon = +let create on_remove on_update colors pos init_name init_color init_icon = let marker = Leaflet.marker pos { title = init_name @@ -72,8 +72,13 @@ let create on_remove on_update pos init_name init_color init_icon = 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 } + [| { label = "Modify" + ; action = fun _ -> + Modal.show (form (on_update pos pos) colors init_name init_color init_icon) + } + ; { label = "Remove" + ; action = fun _ -> on_remove pos + } |]) in @@ -83,6 +88,6 @@ let create on_remove on_update pos init_name init_color init_icon = 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 + Modal.show (form (on_update pos pos) colors init_name init_color init_icon)) in marker -- cgit v1.2.3