335 lines
10 KiB
OCaml
335 lines
10 KiB
OCaml
open Brr
|
|
open Note
|
|
open Note_brr
|
|
open Types
|
|
open Client_types
|
|
open Util
|
|
|
|
let nick post =
|
|
El.a
|
|
~at:
|
|
[ class' "user-link"
|
|
; class' "post-author-nick"
|
|
; mk_at "data-user-id" post.poster_id
|
|
; Fmt.kstr href "/user/%s" post.poster_id
|
|
]
|
|
[ el_txt post.poster_nick ]
|
|
|
|
let date post =
|
|
let print_date t =
|
|
let t = Unix.localtime t in
|
|
Fmt.str "%02d-%02d-%02d %02d:%02d" (1900 + t.tm_year) (1 + t.tm_mon)
|
|
t.tm_mday t.tm_hour t.tm_min
|
|
in
|
|
El.span
|
|
~at:[ class' "post-date"; mk_at "data-time" (string_of_float post.date) ]
|
|
[ el_txt (print_date post.date) ]
|
|
|
|
(* TODO rm this since we can click the post_id? *)
|
|
let link_to_post ?(is_vignette = false) post =
|
|
let url =
|
|
if is_vignette then Fmt.str "/thread/%d#%d" post.parent_t_id post.id
|
|
else Fmt.str "#%d" post.id
|
|
in
|
|
El.a
|
|
~at:[ href url; title "Link to this post"; class' "post-link-to-self" ]
|
|
[ el_txt "#" ]
|
|
|
|
let post_id post =
|
|
let el =
|
|
let at =
|
|
[ class' "post-id"
|
|
; title "Reply to this post"
|
|
; mk_at "data-id" (string_of_int post.id)
|
|
; Fmt.kstr href "#%d" post.id
|
|
]
|
|
in
|
|
El.a ~at [ el_txt (Fmt.str ">>%d" post.id) ]
|
|
in
|
|
hold_on el Ev.click (fun _ev ->
|
|
Events.send_action (Post_form_change Form_open);
|
|
Events.send_action (Post_form_change (Form_insert_quote post.id)) );
|
|
el
|
|
|
|
let post_id_quote =
|
|
let is_local_link t_s id =
|
|
(* list of post currently on the page
|
|
(consider thread page case only) *)
|
|
let post_l =
|
|
match (S.value t_s).Model.page with
|
|
| Thread (Ready v) -> v.reply_l
|
|
| _ -> []
|
|
in
|
|
List.find_opt (fun p -> p.id = id) post_l |> Option.is_some
|
|
in
|
|
let hold_highlight_event el id =
|
|
let mouseenter = Evr.on_el Ev.mouseenter Evr.unit el in
|
|
let mouseleave = Evr.on_el Ev.mouseleave Evr.unit el in
|
|
let focus = Evr.on_el Ev.focus Evr.unit el in
|
|
let blur = Evr.on_el Ev.blur Evr.unit el in
|
|
let off = E.select [ mouseleave; blur ] |> E.map (fun () -> None) in
|
|
let on =
|
|
E.select [ mouseenter; focus ]
|
|
|> E.map (fun () -> Some (get_bounds el, id))
|
|
in
|
|
let event = E.select [ off; on ] in
|
|
hold_event_on el event (fun opt ->
|
|
Events.send_action (Quickview_change opt) );
|
|
()
|
|
in
|
|
fun t_s id ->
|
|
let at = [ class' "post-id-quote"; mk_at "data-id" (string_of_int id) ] in
|
|
let txt = el_txt (Fmt.str ">>%d" id) in
|
|
match is_local_link t_s id with
|
|
| true ->
|
|
(* simple #%d link *)
|
|
let at = [ Fmt.kstr href "#%d" id ] @ at in
|
|
let el = El.a ~at [ txt ] in
|
|
hold_highlight_event el id;
|
|
el
|
|
| false ->
|
|
(* remote link *)
|
|
let at = [ class' "remote" ] @ at in
|
|
let container = El.span [] in
|
|
hold_highlight_event container id;
|
|
let children =
|
|
let open Page in
|
|
S.map (fun t -> t.Model.quickview) t_s
|
|
|> S.changes |> E.filter_map Fun.id
|
|
|> E.map (fun (rect, v) ->
|
|
let quickview_id = unwrap_post_id v in
|
|
fun last_value ->
|
|
match quickview_id = id with
|
|
| true -> Some (rect, v)
|
|
| false -> last_value )
|
|
|> S.accum None
|
|
|> S.map (function
|
|
| None -> [ El.button ~at [ txt ] ]
|
|
| Some (_rect, v) -> (
|
|
match v with
|
|
| Loading _ ->
|
|
let at = [ class' "loading" ] @ at in
|
|
[ El.button ~at [ txt ] ]
|
|
| Not_found _ ->
|
|
let at = [ class' "not-found" ] @ at in
|
|
[ El.button ~at [ txt ] ]
|
|
| Ready p ->
|
|
let at =
|
|
[ class' "ready"
|
|
; Fmt.kstr href "/thread/%d#%d" p.parent_t_id p.id
|
|
]
|
|
@ at
|
|
in
|
|
[ El.a ~at [ txt ] ] ) )
|
|
in
|
|
Elr.def_children container children;
|
|
container
|
|
|
|
let post_menu t_s post =
|
|
let mk s =
|
|
El.a
|
|
~at:
|
|
[ Fmt.kstr href "/%s/%d" s post.id
|
|
; Fmt.kstr class' "%s-link" s
|
|
; mk_at "data-post-id" (string_of_int post.id)
|
|
]
|
|
[ el_txt (String.capitalize_ascii s) ]
|
|
in
|
|
let mk_content () =
|
|
let delete = mk "delete" in
|
|
let report = mk "report" in
|
|
let own_post =
|
|
S.map Model.get_user t_s
|
|
|> S.map (function
|
|
| None -> false
|
|
| Some u -> String.equal u.user_id post.poster_id )
|
|
in
|
|
def_visibility `On own_post delete;
|
|
[ delete; report ]
|
|
in
|
|
Html_util.mk_dropdown_menu ~class_prefix:"post-info" ~label:""
|
|
~at_title:"Post menu" ~placeholder:false mk_content
|
|
|
|
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 =
|
|
match post.image_info with
|
|
| None -> None
|
|
| Some image -> (
|
|
(* TODO show image dimension/name *)
|
|
let mk is_small =
|
|
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 -> Events.send_action (Image_click post.id));
|
|
let img_s =
|
|
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 =
|
|
let open Comment in
|
|
let insert_br_between_lines l =
|
|
match l with
|
|
| [] -> []
|
|
| hd :: tl ->
|
|
List.rev
|
|
@@ List.fold_left (fun acc x -> x :: [ El.br () ] :: acc) [ hd ] tl
|
|
in
|
|
let item t_s = function Txt s -> el_txt s | Id i -> post_id_quote t_s i in
|
|
let items t_s l = List.map (item t_s) l in
|
|
let line t_s = function
|
|
| Line l -> items t_s l
|
|
| Line_quote l ->
|
|
[ El.span ~at:[ class' "line-quote" ] (el_txt ">" :: items t_s l) ]
|
|
in
|
|
fun t_s comment ->
|
|
let content =
|
|
List.map (line t_s) comment |> insert_br_between_lines |> List.flatten
|
|
in
|
|
El.div ~at:[ class' "post-comment" ] content
|
|
|
|
let info t_s post =
|
|
El.div
|
|
~at:[ class' "post-info" ]
|
|
[ nick post
|
|
; date post
|
|
; post_id post
|
|
; link_to_post post
|
|
; post_menu t_s post
|
|
; backlinks t_s post
|
|
]
|
|
|
|
let post_view t_s post =
|
|
let info = info t_s post in
|
|
let content =
|
|
let comment = comment t_s post.comment in
|
|
let l =
|
|
match image t_s post with
|
|
| None -> [ comment ]
|
|
| Some image -> [ image; comment ]
|
|
in
|
|
El.div ~at:[ class' "post-content" ] l
|
|
in
|
|
let at = [ class' "post"; id (string_of_int post.id) ] in
|
|
let el = El.div ~at [ info; content ] in
|
|
let is_selected =
|
|
S.map
|
|
(fun t ->
|
|
match t.Model.fragment with
|
|
| Id v ->
|
|
let id = Fragment.unwrap_id v in
|
|
post.id = id
|
|
| Empty | Top | Bottom -> false )
|
|
t_s
|
|
in
|
|
Elr.def_class (Jstr.v "selected") is_selected el;
|
|
let is_highlighted =
|
|
S.map (fun t -> t.Model.quickview) t_s
|
|
|> S.map (function
|
|
| None -> false
|
|
| Some (_rect, v) -> Int.equal post.id (Page.unwrap_post_id v) )
|
|
in
|
|
Elr.def_class (Jstr.v "highlighted") is_highlighted el;
|
|
el
|
|
|
|
module Quickview = struct
|
|
open Model
|
|
|
|
let quickview_class = "quickview-div"
|
|
|
|
let to_px_jstr x = x |> int_of_float |> Fmt.str "%dpx" |> Jstr.of_string
|
|
|
|
let is_in_viewport post =
|
|
(* find highlighted post DOM element *)
|
|
let id = string_of_int post.id in
|
|
match find_html_el_by_id id with
|
|
| None -> false
|
|
| Some el ->
|
|
(* check bounds *)
|
|
let x, y, w, h = get_bounds el in
|
|
let ( <= ) x y = Float.compare x y <= 0 in
|
|
0. <= x && 0. <= y
|
|
&& x +. w <= window_width ()
|
|
&& y +. h <= window_height ()
|
|
|
|
let f t_s =
|
|
let container = El.div ~at:[ class' quickview_class ] [] in
|
|
let mk (id_x, id_y, id_w, id_h) post =
|
|
if is_in_viewport post then []
|
|
else
|
|
let quickview = post_view t_s post in
|
|
(* ensure we don't have duplicate html id attribute *)
|
|
El.set_at At.Name.id (Some (Jstr.v "quickview")) quickview;
|
|
(* hack: insert hidden quickview into DOM so we can compute it's bounds
|
|
we don't use the viewed post's already in DOM element for this
|
|
- it might actually not be in DOM
|
|
- it might have it's image opened and size changed *)
|
|
El.set_inline_style El.Style.visibility (Jstr.v "hidden") quickview;
|
|
El.set_children container [ quickview ];
|
|
(* compute quickview position *)
|
|
let quickview_x = id_x +. id_w in
|
|
let quickview_h = El.bound_h quickview in
|
|
let quickview_y = id_y +. (0.5 *. id_h) -. (0.5 *. quickview_h) in
|
|
let quickview_y =
|
|
clamp ~min:0. ~max:(window_height () -. quickview_h) quickview_y
|
|
in
|
|
(* undo quickview DOM insertion *)
|
|
El.set_inline_style El.Style.visibility (Jstr.v "visible") quickview;
|
|
El.remove quickview;
|
|
(* set quickview style *)
|
|
El.set_inline_style El.Style.position (Jstr.v "fixed") quickview;
|
|
El.set_inline_style El.Style.z_index (Jstr.v "99999") quickview;
|
|
El.set_inline_style El.Style.left (to_px_jstr quickview_x) quickview;
|
|
El.set_inline_style El.Style.top (to_px_jstr quickview_y) quickview;
|
|
[ quickview ]
|
|
in
|
|
let children =
|
|
S.map (fun t -> t.quickview) t_s
|
|
|> S.map (function
|
|
| None -> []
|
|
| Some (rect, v) -> (
|
|
match v with
|
|
| Page.Loading _ | Not_found _ -> []
|
|
| Ready post -> mk rect post ) )
|
|
in
|
|
Elr.def_children container children;
|
|
container
|
|
end
|