geochan/src/js/js_pretty_post.ml

let log = Format.printf

(* TODO do like in render_time everywhere *)
let inner_html = Brr.El.Prop.jstr (Jstr.of_string "innerHTML")

type image_size =
  | Big
  | Small

let of_string = function
  | "post-image" -> Some Small
  | "post-image-big" -> Some Big
  | _ -> None

let to_string = function Small -> "post-image" | Big -> "post-image-big"

let document = Jv.get Jv.global "document"

(*change postImage class to make it bigger/smaller on click*)
let image_click post_image event =
  log "image_click@\n";
  let current_class =
    Jv.to_string @@ Jv.call post_image "getAttribute" [| Jv.of_string "class" |]
  in
  let new_class =
    match of_string current_class with
    | Some image_size -> ( match image_size with Big -> Small | Small -> Big )
    | None -> failwith "invalid image class name"
  in
  ignore
  @@ Jv.call post_image "setAttribute"
       [| Jv.of_string "class"; Jv.of_string (to_string new_class) |];
  let id =
    Jv.to_string
    @@ Jv.call post_image "getAttribute" [| Jv.of_string "data-id" |]
  in
  let src =
    match new_class with
    | Small -> Format.sprintf "/img/s/%s" id
    | Big -> Format.sprintf "/img/%s" id
  in
  ignore
  @@ Jv.call post_image "setAttribute"
       [| Jv.of_string "src"; Jv.of_string src |];
  (*prevent redirect to /img/:img*)
  ignore @@ Jv.call event "preventDefault" [||];
  ignore @@ Jv.call event "stopPropagation" [||]

let render_time date_span =
  log "render time@\n";
  let data_time =
    match Brr.El.at (Jstr.of_string "data-time") date_span with
    | None -> failwith "no attribute data-time for date element"
    | Some data_time -> Jstr.to_float data_time
  in
  (*
     let t =
       Jv.to_float
         (Jv.call date_span "getAttribute" [| Jv.of_string "data-time" |])
     in
  *)
  let t = Unix.localtime data_time in
  let date =
    Format.sprintf "%02d-%02d-%02d %02d:%02d" (1900 + t.tm_year) (1 + t.tm_mon)
      t.tm_mday t.tm_hour t.tm_min
  in
  Brr.El.set_prop inner_html (Jstr.of_string date) date_span

let preview_ref = ref None

let highlighted_ref = ref None

let selected_ref = ref None

(* todo use brr *)
let add_class name el =
  let class_list = Jv.get el "classList" in
  ignore @@ Jv.call class_list "add" [| Jv.of_string name |]

let remove_class name el =
  let class_list = Jv.get el "classList" in
  ignore @@ Jv.call class_list "remove" [| Jv.of_string name |]

let on_hashchange _event =
  log "on hashchange";
  let frag =
    Jstr.to_string @@ Brr.Uri.fragment @@ Brr.Window.location Brr.G.window
  in
  match Jv.find Jv.global frag with
  | None -> log "fragment not found on the page"
  | Some reply ->
    let () =
      match !selected_ref with
      | None -> ()
      | Some item -> remove_class "selected" item
    in
    let () = add_class "selected" reply in
    selected_ref := Some reply

let on_mouse_over el _event =
  log "on mouse over@\n";
  (*get id of reply *)
  let reply_id =
    Jv.to_string @@ Jv.call el "getAttribute" [| Jv.of_string "data-id" |]
  in
  (* (try to) get div of reply *)
  match Jv.find Jv.global reply_id with
  | None -> failwith "error getting reply_div, this reply is not on this page"
  | Some reply_div ->
    (* check if it in view, if it is, just make it of class `highlight` *)
    let reply_bounding_rect = Jv.call reply_div "getBoundingClientRect" [||] in
    let window = Jv.get Jv.global "window" in
    let window_height = Jv.get window "innerHeight" |> Jv.to_int in
    let reply_top = Jv.get reply_bounding_rect "top" |> Jv.to_int in
    if reply_top < window_height - 50 then (
      let class_list = Jv.get reply_div "classList" in
      ignore @@ Jv.call class_list "add" [| Jv.of_string "highlight" |];
      highlighted_ref := Some reply_div )
    else
      (* copy it to make new div  `floating-reply-preview` *)
      let preview_div = Jv.call reply_div "cloneNode" [| Jv.of_bool true |] in
      ignore
      @@ Jv.call preview_div "setAttribute"
           [| Jv.of_string "class"
            ; Jv.of_string "floating-reply-preview post"
           |];
      ignore
      @@ Jv.call preview_div "setAttribute"
           [| Jv.of_string "id"; Jv.of_string "floating-reply-preview" |];
      (* append to DOM *)
      ignore @@ Jv.call el "after" [| preview_div |];
      (* place it next to the reply-link el*)
      let bounding_rect = Jv.call el "getBoundingClientRect" [||] in
      let top =
        let el_top = Jv.get bounding_rect "top" |> Jv.to_int in
        let reply_height = Jv.get reply_bounding_rect "height" |> Jv.to_int in
        Int.min el_top (window_height - reply_height - 5)
        |> Format.sprintf "%dpx" |> Jv.of_string
      in
      let right =
        Jv.get bounding_rect "right"
        |> Jv.to_int |> Format.sprintf "%dpx" |> Jv.of_string
      in
      let style = Jv.get preview_div "style" in
      ignore @@ Jv.set style "position" (Jv.of_string "fixed");
      ignore @@ Jv.set style "z-index" (Jv.of_int 42);
      ignore @@ Jv.set style "top" top;
      ignore @@ Jv.set style "left" right;

      (* set preview_div ref for on_mouse_out *)
      preview_ref := Some preview_div;
      ()

let on_mouse_out _el _event =
  log "on mouse out@\n";
  (* get the `reply-preview` element, delete it if Some*)
  let () =
    match !highlighted_ref with
    | None -> ()
    | Some highlighted_div ->
      let class_list = Jv.get highlighted_div "classList" in
      ignore @@ Jv.call class_list "remove" [| Jv.of_string "highlight" |]
  in
  match !preview_ref with
  | None -> ()
  | Some preview_div ->
    ignore @@ Jv.call preview_div "remove" [||];
    (* if None, get the `selected-reply-preview` element (by class) and remove this class *)
    ()

let make_pretty _event =
  log "make pretty@\n";

  let add_event_to_class ~name ~event handler =
    (* TODO use brr? *)
    let event = Brr.Ev.Type.create (Jstr.of_string event) in
    let el_list = Brr.El.find_by_class (Jstr.of_string name) in
    List.iter
      (fun el ->
        (* TODO handler should take Brr.El. ? *)
        Brr.Ev.listen event (handler el) (Brr.El.as_target el) )
      el_list
  in

  let dates = Brr.El.find_by_class (Jstr.of_string "date") in
  List.iter render_time dates;

  (*(*add event image_click to all postImage*)
    let () = add_event_to_class ~name:"post-image" ~event:"click" image_click in

    (*add event mouse_over/out to all reply-link *)
    let () =
      add_event_to_class ~name:"reply-link" ~event:"mouseover" on_mouse_over
    in
  *)
  let () =
    add_event_to_class ~name:"reply-link" ~event:"mouseout" on_mouse_out
  in

  (* add fragment listener to mark as selected the linked post *)
  let window = Jv.get Jv.global "window" in
  ignore
  @@ Jv.call window "addEventListener"
       [| Jv.of_string "hashchange"; Jv.repr on_hashchange |]

(*make pretty after page load*)
let () =
  log "add load eventlistener to make pretty@\n";
  let window = Jv.get Jv.global "window" in
  ignore
  @@ Jv.call window "addEventListener"
       [| Jv.of_string "load"; Jv.repr make_pretty |]

(* TODO add a selected class for post clicked / in fragment *)
(* see https://developer.mozilla.org/en-US/docs/Web/API/Window/hashchange_event *)
(* TODO reply can be in another thread, how to display it? if displaying it on mouseover we need to fetch it. and display it in special color. need to change pp_post in pp_babillard *)
(* mouseout not fired when scrolling wtf *)
(* TODO link to post in comment should be of class reply-link *)
(* TODO preview should stay in viewport (bug if near the end of viewport) *)