add image-overlay

src/assets/css/style.css

@@ -10,6 +10,7 @@
   --text: #333333;
   --light-text: #5a5a5a;
   --quote: #FFB300;
+  --bg-image-overlay: rgba(0, 0, 0, 0.75);
   --bg-post: #C5E1A5;
   --border-post: #9dd162;
   --bg-post-highlight: #9dd162;
@@ -110,6 +111,7 @@ nav a:hover, nav button:hover,
   width: 100%;
   top: 0;
   left: 0;
+  z-index: 1;
 }
 
 .home-left-navigation-div {
@@ -127,7 +129,7 @@ nav a:hover, nav button:hover,
   justify-content: flex-end;
   right: 0;
   margin-right: 7vw;
-  z-index: 999;
+  z-index: 2;
 }
 
 .new-thread-view {
@@ -149,7 +151,7 @@ nav a:hover, nav button:hover,
   }
   .dropdown-content {
     transition: 0.2s ease-out;
-    z-index: 100000;
+    z-index: 2;
     position: absolute;
     top: 100%;
     left: 0;
@@ -189,7 +191,7 @@ nav a:hover, nav button:hover,
     top: 0;
     left: 0;
     opacity: 0;
-    z-index: 99;
+    z-index: 2;
   }
   &:focus-within .dropdown-close-btn:not(:focus) {
     display: inline-block;
@@ -214,6 +216,31 @@ nav a:hover, nav button:hover,
   margin-top: auto;
 }
 
+/* don't use [img] selector because it interfere with leaflet */
+.image {
+  object-fit: contain;
+  width: 100%;
+  height: auto;
+}
+
+.image-small {
+  max-width: 30vw;
+  max-height: 30vh;
+}
+
+.image-overlay {
+  position: absolute;
+  top: 0;
+  left: 0;
+  width: 100vw;
+  height: 100vh;
+  background-color: var(--bg-image-overlay);
+  display: flex;
+  align-items: center;
+  justify-content: center;
+  z-index: 5;
+}
+
 .thread {
   margin-inline: 1vw;
   margin-block: 3vw;
@@ -314,20 +341,9 @@ nav a:hover, nav button:hover,
   gap: 10px;
 }
 
-/* TODO use image dim? better max-size? */
 .post-image-div {
 }
 
-.post-image {
-  max-width: 90vw;
-  height: auto;
-}
-
-.post-image-small {
-  max-width: 30vw;
-  max-height: 30vh;
-}
-
 .post-comment {
   color: var(--text);
   padding-top: 10px;
@@ -353,7 +369,7 @@ nav a:hover, nav button:hover,
   background-color: var(--bg-form);
   border: 2px solid var(--border-form);
   padding: 5px;
-  z-index: 999990;
+  z-index: 3;
 }
 .reply-popup-dragzone {
   display: flex;
@@ -387,7 +403,7 @@ nav a:hover, nav button:hover,
   right: 1vw;
   bottom: 1vh;
   padding: 5px;
-  z-index: 999999;
+  z-index: 4;
   background-color: var(--bg-error-popup);
   border: 2px solid var(--border-error-popup);
   border-radius: 12px;

src/client/client_types.ml

@@ -109,13 +109,19 @@ type form_action =
    needed to compute quickview position *)
 type rect = float * float * float * float
 
+module Img_info = struct
+  type t =
+    | Avatar of string * img_info
+    | Post of int * img_info
+end
+
 type action =
   | Navigation_event of (Page.t option * Fragment.t)
   | Post_form_change of form_action
   | Map_input of map_action
   | Submit_event of (Form_kind.wrapped * Brr.El.t)
   | Quickview_change of (rect * post_id) option
-  | Image_click of post_id
+  | Image_change of Img_info.t option
   | Clear_error
 
 type data_update =
@@ -181,6 +187,13 @@ let pp_form_action fmt a =
     | Some (lat, lng) -> Fmt.pf fmt "latlng `(%f, %f)`" lat lng )
   | Form_reset -> Fmt.pf fmt "reset"
 
+let pp_image_change fmt = function
+  | None -> ()
+  | Some v -> (
+    match v with
+    | Img_info.Avatar (id, _img_info) -> Fmt.pf fmt "image click `%s`" id
+    | Post (id, _img_info) -> Fmt.pf fmt "image click `%d`" id )
+
 let pp_action fmt = function
   | Navigation_event (opt, frag) ->
     let s =
@@ -194,7 +207,7 @@ let pp_action fmt = function
   | Submit_event (W kind, _el) ->
     Fmt.pf fmt "submit event `%s`" (Form_kind.name kind)
   | Quickview_change _opt -> Fmt.pf fmt "quickview change"
-  | Image_click post_id -> Fmt.pf fmt "image click `%d`" post_id
+  | Image_change opt -> pp_image_change fmt opt
   | Clear_error -> Fmt.pf fmt "clear error"
 
 let pp_data_update fmt a =

src/client/html.ml

@@ -310,6 +310,23 @@ module Error_popup = struct
     el
 end
 
+module Image_overlay = struct
+  let mk opt =
+    match opt with
+    | None -> []
+    | Some img ->
+      let el = mk_image ~is_small:false img in
+      [ el ]
+
+  let f t_s =
+    let el = El.div ~at:[ class' "image-overlay" ] [] in
+    def_visibility `On (S.map (fun t -> Option.is_some t.opened_image) t_s) el;
+    Elr.def_children el (S.map (fun t -> mk t.opened_image) t_s);
+    (* on overlay click (that should cover whole screen) send action to close overlay *)
+    hold_on el Ev.click (fun _ev -> Events.send_action (Image_change None));
+    el
+end
+
 module Main = struct
   let f t_s =
     let l =
@@ -326,6 +343,7 @@ module Main = struct
         ; Delete.f
         ; Report.f
         ; Error_popup.f
+        ; Image_overlay.f
         ]
     in
     let main = El.v (str "main") l in

src/client/html_post.ml

@@ -154,54 +154,20 @@ let backlinks t_s post =
   let l = List.map (post_id_quote t_s) post.backlinks in
   El.div ~at:[ class' "post-replies" ] l
 
-let image t_s ?(is_vignette = false) post =
+let image _t_s ?(is_vignette = false) post =
   match post.image_info with
   | None -> None
   | Some image -> (
-    (* TODO show image dimension/name *)
+    let img_small =
-    let mk is_small =
+      Html_util.mk_image ~is_small:true (Img_info.Post (post.id, image))
-      let class_small =
-        if is_small then [ class' "post-image-small" ] else []
-      in
-      let sizes =
-        [ mk_at "width"
-            (string_of_int (if is_small then image.thumb_w else image.w))
-        ; mk_at "height"
-            (string_of_int (if is_small then image.thumb_h else image.h))
-        ]
-      in
-      let url =
-        src
-        @@
-        if is_small then Fmt.str "/img/s/%d" post.id
-        else Fmt.str "/img/%d" post.id
-      in
-      let at =
-        class_small @ sizes
-        @ url
-          :: [ class' "post-image"
-             ; alt image.alt
-             ; title image.alt
-             ; mk_at "data-id" (string_of_int post.id)
-             ; mk_at "loading" "lazy"
-             ]
-      in
-      El.img ~at ()
     in
-    let img_small, img_big = (mk true, mk false) in
     let el = El.div ~at:[ class' "post-image-div" ] [ img_small ] in
     match is_vignette with
     | true -> Some el
     | false ->
-      (* swap img_(small/big) on click *)
+      hold_on el Ev.click (fun _ev ->
-      hold_on el Ev.click (fun _ev -> Events.send_action (Image_click post.id));
+          let v = Img_info.Post (post.id, image) in
-      let img_s =
+          Events.send_action (Image_change (Some v)) );
-        S.map (fun t -> t.Model.opened_image) t_s
-        |> S.map (function
-             | Some id when Int.equal id post.id -> [ img_big ]
-             | Some _ | None -> [ img_small ] )
-      in
-      Elr.def_children el img_s;
       Some el )
 
 let comment =

src/client/html_util.ml

@@ -99,3 +99,38 @@ let new_thread_link_el t_s =
   let children = S.map get_user t_s |> S.map (fun u -> [ mk u ]) in
   Elr.def_children el children;
   el
+
+let mk_image ~is_small img_info =
+  let id, image =
+    match img_info with
+    | Client_types.Img_info.Avatar (id, image) -> (id, image)
+    | Post (id, image) -> (string_of_int id, image)
+  in
+  let url =
+    match img_info with
+    | Client_types.Img_info.Avatar _ when is_small ->
+      Fmt.str "/img/avatar/s/%s" id
+    | Avatar _ -> Fmt.str "/img/avatar/%s" id
+    | Post _ when is_small -> Fmt.str "/img/s/%s" id
+    | Post _ -> Fmt.str "/img/%s" id
+  in
+  let class_small = if is_small then [ class' "image-small" ] else [] in
+  let sizes =
+    [ mk_at "width"
+        (string_of_int (if is_small then image.thumb_w else image.w))
+    ; mk_at "height"
+        (string_of_int (if is_small then image.thumb_h else image.h))
+    ]
+  in
+  let url = src url in
+  let at =
+    class_small @ sizes
+    @ url
+      :: [ class' "image"
+         ; alt image.alt
+         ; title image.alt
+         ; mk_at "data-id" id
+         ; mk_at "loading" "lazy"
+         ]
+  in
+  El.img ~at ()

src/client/leaflet_map.ml

@@ -112,7 +112,7 @@ let toggle_latlng_popup latlng_opt =
 
 module Markers = struct
   let icon mode =
-    (* TODO define in App *)
+    (* TODO config *)
     let default_url = "/assets/img/marker-icon.png" in
     let default_icon = Icon.create default_url [||] in
     let selected_icon = Icon.create default_url [||] in

src/client/model.ml

@@ -13,7 +13,7 @@ type t =
   ; map_view : float * float * int
   ; (* todo: just remove rect from here *)
     quickview : (rect * (post_id, post) wrap) option
-  ; opened_image : post_id option
+  ; opened_image : Img_info.t option
   ; error : Client_types.error option
   }
 
@@ -264,11 +264,7 @@ let do_action : Client_types.action -> t -> t =
       | _ -> ()
     end;
     { t with quickview }
-  | Image_click id -> (
+  | Image_change opened_image -> { t with opened_image }
-    match t.opened_image with
-    | Some current_image_id when Int.equal current_image_id id ->
-      { t with opened_image = None }
-    | Some _ | None -> { t with opened_image = Some id } )
   | Clear_error -> { t with error = None }
 
 let do_data_update : Client_types.data_update -> t -> t =

src/geochan.ml

@@ -71,12 +71,17 @@ let get_post_image ~thumbnail request =
   in
   render_result_img request ~headers res
 
-let get_avatar_image request =
+let get_avatar_image ~thumbnail request =
+  (* TODO cache *)
+  let headers =
+    [ ("Cache-Control", Fmt.str "max-age=%d, immutable" cache_max_age) ]
+  in
+  let f = if thumbnail then User.get_thumbnail_data else User.get_image_data in
   let res =
     let* user_id = Api.url_param request User_id in
-    User.get_image user_id
+    f user_id
   in
-  render_result_img request ~headers:[] res
+  render_result_img request ~headers res
 
 (* -- ~~ -- *)
 
@@ -123,7 +128,8 @@ let routes =
   :: [ Dream.get "/assets/**" (Dream.static ~loader:asset_loader "")
      ; Dream.get "/img/:image_id" (get_post_image ~thumbnail:false)
      ; Dream.get "/img/s/:image_id" (get_post_image ~thumbnail:true)
-     ; Dream.get "/user/:user_id/avatar" get_avatar_image
+     ; Dream.get "/img/avatar/:user_id" (get_avatar_image ~thumbnail:false)
+     ; Dream.get "/img/avatar/s/:user_id" (get_avatar_image ~thumbnail:true)
      ; Dream.get "/**" app_start_page
      ]
 

src/user.ml

@@ -95,15 +95,20 @@ let update_password user_id password =
   in
   Db_user.update_password_hash user_id password_hash
 
-let get_image user_id =
+let default_avatar =
+  (* TODO config *)
   let default_avatar_path = "/img/default_avatar.png" in
+  match Assets.read default_avatar_path with
+  | None -> Error (Internal (Db_not_found "can not find default avatar file"))
+  | Some avatar -> Ok avatar
+
+let get_thumbnail_data user_id =
   let* opt = Db_image.U.data user_id in
-  match opt with
+  match opt with Some data -> Ok data | None -> default_avatar
-  | Some data -> Ok data
+
-  | None -> (
+let get_image_data user_id =
-    match Assets.read default_avatar_path with
+  let* opt = Db_image.U.data user_id in
-    | None -> Error (Internal (Db_not_found "can not find default avatar file"))
+  match opt with Some data -> Ok data | None -> default_avatar
-    | Some avatar -> Ok avatar )
 
 (* TODO sql : rm image db functor, handle avatar image and transaction in db_user *)
 let upload_avatar user_id (name_opt, alt, content) =

test/test.ml

@@ -96,7 +96,7 @@ module Test_user = struct
   let get_image () =
     (check unit_result) "is ok" (Ok ())
       (let* id = get_id () in
-       let* _image_data : string = User.get_image id in
+       let* _image_data : string = User.get_image_data id in
        Ok () );
     ()