From 281b40d64a3d72417c9818a1e2ffd146617d6115 Mon Sep 17 00:00:00 2001 From: Swrup Date: Tue, 15 Apr 2025 06:41:50 +0200 Subject: [PATCH] def_visibility + reactive map buttons --- src/client/html.ml | 25 ++++++++++--------------- src/client/html_form.ml | 2 +- src/client/html_post.ml | 2 +- src/client/html_thread.ml | 20 +++----------------- src/client/html_util.ml | 25 +++++++++++++++++++++++-- src/client/leaflet_map.ml | 17 ++++++++++------- src/client/util.ml | 7 ++++--- 7 files changed, 52 insertions(+), 46 deletions(-) diff --git a/src/client/html.ml b/src/client/html.ml index 4860e2d..d48b4da 100644 --- a/src/client/html.ml +++ b/src/client/html.ml @@ -64,19 +64,19 @@ module Home = struct ] in let thread_view = Html_thread.f t_s in - let new_thread_link = Html_thread.new_thread_link_el t_s in + let new_thread_link = Html_util.new_thread_link_el t_s in let return_link = El.a ~at:[ href (to_path Home) ] [ el_txt "Return" ] in let navigation_div = El.div ~at:[ class' "home-left-navigation-div" ] [ new_thread_link; return_link ] in - let mode k = S.map (is_page_kind k) t_s in - def_on (mode New_thread) new_thread_view; - def_off (mode Thread) navigation_div; - def_on (mode Thread) thread_view; - def_off (mode New_thread) new_thread_link; - def_on (mode New_thread) return_link; + def_visibility_when_page [ New_thread ] `On new_thread_view t_s; + def_visibility_when_page [ Thread ] `Off navigation_div t_s; + def_visibility_when_page [ Thread ] `On thread_view t_s; + def_visibility_when_page [ New_thread ] `On return_link t_s; + (* done in new_thread_link_el fun + def_visibility_when_page [ New_thread ] `Off new_thread_link t_s;*) let el = El.div ~at:[ class' "home-left" ] @@ -88,13 +88,7 @@ module Home = struct let left_el = left t_s in let right_el = Leaflet_map.f t_s in let el = El.div ~at:[ class' "home-page" ] [ left_el; right_el ] in - def_on - (S.map - (fun t -> - is_page_kind Home t || is_page_kind New_thread t - || is_page_kind Thread t ) - t_s ) - el; + def_visibility_when_page [ Home; New_thread; Thread ] `On el t_s; el end @@ -311,7 +305,8 @@ module Error_popup = struct let f t_s = let el = El.div ~at:[ class' "error-popup" ] [] in Elr.def_children el (S.map (fun t -> mk el t.error) t_s); - def_off (S.map (fun t -> Option.is_none t.error) t_s) el; + let is_error = S.map (fun t -> Option.is_some t.error) t_s in + def_visibility `On is_error el; el end diff --git a/src/client/html_form.ml b/src/client/html_form.ml index a9578eb..a8b822e 100644 --- a/src/client/html_form.ml +++ b/src/client/html_form.ml @@ -156,7 +156,7 @@ let mk_image_div t_s = let (file_label, file), alt = mk_image_field_unwraped () in let () = let has_file = S.map (fun t -> Option.is_some t.post_form.file) t_s in - Util.def_on has_file alt; + Util.def_visibility `On has_file alt; let on = S.map (fun t -> t.post_form.alt) t_s |> S.changes |> E.filter_map Fun.id |> E.map Jstr.v diff --git a/src/client/html_post.ml b/src/client/html_post.ml index 23c9e21..9c11a93 100644 --- a/src/client/html_post.ml +++ b/src/client/html_post.ml @@ -144,7 +144,7 @@ let post_menu t_s post = | None -> false | Some u -> String.equal u.user_id post.poster_id ) in - def_on own_post delete; + def_visibility `On own_post delete; [ delete; report ] in Html_util.mk_dropdown_menu ~class_prefix:"post-info" ~label:"" diff --git a/src/client/html_thread.ml b/src/client/html_thread.ml index 205e40c..d104938 100644 --- a/src/client/html_thread.ml +++ b/src/client/html_thread.ml @@ -53,22 +53,8 @@ let reply_popup_el t_s w = in let el = El.div ~at:[ class' "reply-popup" ] [ dragzone; content ] in Html_form.Dragzone.f ~dragzone el; - let is_visible_s = S.map (fun t -> t.post_form.is_open) t_s in - def_on is_visible_s el; - el - -let new_thread_link_el t_s = - let mk user = - match user with - | None -> - (* TODO redirect *) - mk_page_link ~label:"Login to post a thread!" Login - | Some _user -> - El.a ~at:[ href (Page.to_path New_thread) ] [ el_txt "New thread" ] - in - let el = El.div ~at:[ class' "new-thread-link-div" ] [] in - let children = S.map get_user t_s |> S.map (fun u -> [ mk u ]) in - Elr.def_children el children; + let is_open = S.map (fun t -> t.post_form.is_open) t_s in + def_visibility `On is_open el; el let bump_status_el v = @@ -128,7 +114,7 @@ let nav_el kind t_s w = in let el = El.div ~at - [ new_thread_link_el t_s + [ Html_util.new_thread_link_el t_s ; reply_btn_el t_s w ; update_el ; El.a diff --git a/src/client/html_util.ml b/src/client/html_util.ml index 4135605..1c56ea3 100644 --- a/src/client/html_util.ml +++ b/src/client/html_util.ml @@ -1,5 +1,6 @@ open Brr open Note +open Note_brr open Model open Util @@ -24,13 +25,18 @@ let mk_page_link ?label p = let is_page_kind k t = Page.(Kind.equal k (to_kind t.page)) +let def_visibility_when_page page_kind_l (visibility : [ `On | `Off ]) el t_s = + let b_s = + S.map (fun t -> List.exists (fun k -> is_page_kind k t) page_kind_l) t_s + in + def_visibility visibility b_s el + let mk_page kind t_s l = let el = let at = [ Fmt.kstr class' "%s-page" (Page.Kind.to_string kind) ] in El.div ~at l in - let is_on = S.map (is_page_kind kind) t_s in - def_on is_on el; + def_visibility_when_page [ kind ] `On el t_s; el let insert_br s = @@ -78,3 +84,18 @@ let mk_dropdown_menu ~class_prefix ~label ~at_title ~placeholder mk_content = @ [ mk_dropdown_content ""; mk_btn "-close-btn" ] in El.div ~at l + +let new_thread_link_el t_s = + let mk user = + match user with + | None -> + (* TODO redirect *) + mk_page_link ~label:"Login to post a thread!" Login + | Some _user -> + El.a ~at:[ href (Page.to_path New_thread) ] [ el_txt "New thread" ] + in + let el = El.div ~at:[ class' "new-thread-link-div" ] [] in + def_visibility_when_page [ New_thread ] `Off el t_s; + let children = S.map get_user t_s |> S.map (fun u -> [ mk u ]) in + Elr.def_children el children; + el diff --git a/src/client/leaflet_map.ml b/src/client/leaflet_map.ml index 1d33cd7..a05558c 100644 --- a/src/client/leaflet_map.ml +++ b/src/client/leaflet_map.ml @@ -7,12 +7,6 @@ let geoloc_btn = let s = "geolocalize-btn" in El.button ~at:[ class' s; id s ] [ el_txt "Geolocalize me" ] -let buttons = - let new_thread_link = - El.a ~at:[ href (Page.to_path New_thread) ] [ el_txt "New thread" ] - in - El.div ~at:[ class' "map-btn-div" ] [ new_thread_link; geoloc_btn ] - let map_el = El.div ~at:[ id "map" ] [] let map = Map.create_from_div map_el @@ -178,6 +172,14 @@ module Markers = struct set_layer layer end +let mk t_s = + let buttons = + El.div + ~at:[ class' "map-btn-div" ] + [ Html_util.new_thread_link_el t_s; geoloc_btn ] + in + [ map_el; buttons ] + let f t_s = let open Model in S.map (fun t -> t.post_form.latlng) t_s @@ -195,5 +197,6 @@ let f t_s = |> hold_endless (fun id_opt -> Markers.select id_opt; Markers.refresh (S.value t_s).catalog ); - let el = El.div ~at:[ class' "home-right" ] [ map_el; buttons ] in + let children = mk t_s in + let el = El.div ~at:[ class' "home-right" ] children in el diff --git a/src/client/util.ml b/src/client/util.ml index 252208d..d0a3283 100644 --- a/src/client/util.ml +++ b/src/client/util.ml @@ -63,9 +63,10 @@ let clamp ~min ~max x = Float.max (Float.min max x) min open Note open Note_brr -let def_off b_s el = Elr.def_class (str "off") b_s el - -let def_on b_s el = Elr.def_class (str "off") (S.map not b_s) el +let def_visibility (visibility : [ `On | `Off ]) b_s el = + match visibility with + | `On -> Elr.def_class (str "off") (S.map not b_s) el + | `Off -> Elr.def_class (str "off") b_s el let def_disabled b_s el = Elr.def_at At.Name.disabled