From 08781ea92f35ba0e6168ddf0f8b3ff4ffe67b5ad Mon Sep 17 00:00:00 2001 From: Swrup Date: Fri, 30 May 2025 05:15:53 +0200 Subject: [PATCH] better geocalize btn + geolocation state --- src/assets/css/style.css | 18 ++++++++++ src/client/client_types.ml | 32 ++++++++++++------ src/client/leaflet_map.ml | 68 ++++++++++++++++++++++---------------- src/client/model.ml | 6 ++-- 4 files changed, 81 insertions(+), 43 deletions(-) diff --git a/src/assets/css/style.css b/src/assets/css/style.css index 02d88f7..c1b3902 100644 --- a/src/assets/css/style.css +++ b/src/assets/css/style.css @@ -148,6 +148,24 @@ nav a:hover, nav button:hover, opacity: 1; } } + + .geolocalize-btn { + background: none; + border: none; + padding: 0; + cursor: pointer; + display: inline-flex; + align-items: center; + justify-content: center; + max-height: 3vw; + max-width: 3vw; + } + + .geolocalize-btn img { + display: block; + max-width: 100%; + height: auto; + } } .form-box { diff --git a/src/client/client_types.ml b/src/client/client_types.ml index dc11722..8dfc1de 100644 --- a/src/client/client_types.ml +++ b/src/client/client_types.ml @@ -85,14 +85,18 @@ type error = | Network_err of network_error | Err_response of Err.t +type geolocation_state = + | Geo_off + | Geo_started + | Geo_located of Brr_io.Geolocation.Pos.t + | Geo_error of Brr_io.Geolocation.Error.t + type map_action = | Move_end of (float * float * int) | Zoom_end of (float * float * int) | Click_latlng of (float * float) | Click_marker of Types.post_id - | Geoloc_start - | Geoloc_pos of Brr_io.Geolocation.Pos.t - | Geoloc_err of Brr_io.Geolocation.Error.t + | Geolocation of geolocation_state type form_action = | Form_open @@ -153,6 +157,19 @@ let pp_error fmt err = | Network_err e -> pp_network_error fmt e | Err_response e -> Err.pp fmt e +let pp_geolocation fmt a = + Fmt.pf fmt "geolocation "; + match a with + | Geo_off -> Fmt.pf fmt "off" + | Geo_started -> Fmt.pf fmt "started" + | Geo_located pos -> + let open Brr_io.Geolocation.Pos in + Fmt.pf fmt "geoloc pos `(%f, %f)`" (latitude pos) (longitude pos) + | Geo_error err -> + let open Brr_io.Geolocation.Error in + Fmt.pf fmt "geoloc error, code `%d` message `%s`" (code err) + (message err |> Jstr.to_string) + let pp_map_action fmt a = Fmt.pf fmt "map "; match a with @@ -162,14 +179,7 @@ let pp_map_action fmt a = Fmt.pf fmt "zoom end `(%f, %f, %d)`" lat lng zoom | Click_latlng (lat, lng) -> Fmt.pf fmt "click latlng `(%f, %f)`" lat lng | Click_marker post_id -> Fmt.pf fmt "click marker `%d`" post_id - | Geoloc_start -> Fmt.pf fmt "geoloc start" - | Geoloc_pos pos -> - let open Brr_io.Geolocation.Pos in - Fmt.pf fmt "geoloc pos `(%f, %f)`" (latitude pos) (longitude pos) - | Geoloc_err err -> - let open Brr_io.Geolocation.Error in - Fmt.pf fmt "geoloc error, code `%d` message `%s`" (code err) - (message err |> Jstr.to_string) + | Geolocation o -> pp_geolocation fmt o let pp_form_action fmt a = Fmt.pf fmt "form "; diff --git a/src/client/leaflet_map.ml b/src/client/leaflet_map.ml index 2dd45ee..5e67971 100644 --- a/src/client/leaflet_map.ml +++ b/src/client/leaflet_map.ml @@ -3,10 +3,6 @@ open Note open Leaflet open Util -let geoloc_btn = - let s = "geolocalize-btn" in - El.button ~at:[ class' s; id s ] [ el_txt "Geolocalize me" ] - let map_el = El.div ~at:[ id "map" ] [] let map = Map.create_from_div map_el @@ -71,36 +67,35 @@ let () = let lat = Latlng.lat latlng in let lng = Latlng.lng latlng in Events.send_action (Map_input (Click_latlng (lat, lng))) ); - (* TODO: + () + +(* TODO: - show a loading animation until we get the geolocation - show something in case of error - add special marker on map *) - let geolocalize _ev = - let open Brr_io.Geolocation in - let l = of_navigator G.navigator in - let opts = opts ~high_accuracy:true () in - Events.send_action (Map_input Geoloc_start); - (* only get first Geoloc_pos for now +let geolocalize _ev = + let open Brr_io.Geolocation in + let l = of_navigator G.navigator in + let opts = opts ~high_accuracy:true () in + Events.send_action (Map_input (Geolocation Geo_started)); + (* only get first Geoloc_pos for now let _ : watch_id = - watch l ~opts (fun pos_res -> - *) - let _fut : unit Fut.t = - get l ~opts - |> Fut.map (fun pos_res -> - match pos_res with - | Error err -> Events.send_action (Map_input (Geoloc_err err)) - | Ok pos -> - Events.send_action (Map_input (Geoloc_pos pos)); - let lat = Pos.latitude pos in - let lng = Pos.longitude pos in - let zoom = 17 in - set_view (lat, lng, zoom); - Storage.set_map_view (lat, lng, zoom); - () ) - in - () + watch l ~opts (fun pos_res -> *) + let _fut : unit Fut.t = + get l ~opts + |> Fut.map (fun pos_res -> + match pos_res with + | Error err -> + Events.send_action (Map_input (Geolocation (Geo_error err))) + | Ok pos -> + Events.send_action (Map_input (Geolocation (Geo_located pos))); + let lat = Pos.latitude pos in + let lng = Pos.longitude pos in + let zoom = 17 in + set_view (lat, lng, zoom); + Storage.set_map_view (lat, lng, zoom); + () ) in - hold_on geoloc_btn Ev.click geolocalize; () let toggle_latlng_popup latlng_opt = @@ -173,6 +168,21 @@ module Markers = struct end let mk t_s = + let geoloc_btn = + let img = El.img ~at:[] () in + Note_brr.Elr.def_at At.Name.src + ( t_s + |> S.map (fun t -> t.Model.geolocation) + |> S.map (function + (* TODO need a loading animation *) + | Client_types.Geo_located _ -> "/assets/img/location_on.png" + | _ -> "/assets/img/location_off.png" ) + |> S.map (fun s -> s |> Jstr.v |> Option.some) ) + img; + let el = El.button ~at:[ class' "geolocalize-btn" ] [ img ] in + hold_on el Ev.click geolocalize; + el + in let buttons = El.div ~at:[ class' "map-btn-div" ] diff --git a/src/client/model.ml b/src/client/model.ml index 019ea3b..6d122f7 100644 --- a/src/client/model.ml +++ b/src/client/model.ml @@ -11,6 +11,7 @@ type t = ; page : Page.t ; post_form : Post_form_data.t ; map_view : float * float * int + ; geolocation : geolocation_state ; (* todo: just remove rect from here *) quickview : (rect * (post_id, post) wrap) option ; opened_image : Img_info.t option @@ -32,6 +33,7 @@ let init () = ; page = Home ; post_form = Post_form_data.empty ; map_view = Storage.init_map_view () + ; geolocation = Geo_off ; quickview = None ; opened_image = None ; error = None @@ -196,12 +198,10 @@ let do_map_action a t = | Move_end map_view | Zoom_end map_view -> Storage.set_map_view map_view; { t with map_view } - | Geoloc_start -> t - | Geoloc_pos (_pos : Brr_io.Geolocation.Pos.t) -> t - | Geoloc_err (_err : Brr_io.Geolocation.Error.t) -> t | Click_latlng latlng -> ( match t.page with New_thread -> set_latlng t (Some latlng) | _ -> t ) | Click_marker _thread_id -> set_latlng t None + | Geolocation geolocation -> { t with geolocation } let do_action : Client_types.action -> t -> t = fun action t ->