better geocalize btn + geolocation state

This commit is contained in:
Swrup 2025-05-30 05:15:53 +02:00
parent f566952613
commit bebc23bd96
4 changed files with 81 additions and 43 deletions

View file

@ -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 {

View file

@ -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 ";

View file

@ -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" ]

View file

@ -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 ->