open Brr open Utils 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" (*change postImage class to make it bigger/smaller on click*) let image_click post_image event = log "image_click@\n"; let class_jstr = Jstr.of_string "class" in let current_class = match El.at class_jstr post_image with | None -> failwith "no class for post_image" | Some c -> Jstr.to_string c 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 El.set_at class_jstr (Some (Jstr.of_string (to_string new_class))) post_image; let id = match El.at (Jstr.of_string "data-id") post_image with | None -> failwith "no data-id on post_image" | Some id -> Jstr.to_string id in let src = match new_class with | Small -> Format.sprintf "/img/s/%s" id | Big -> Format.sprintf "/img/%s" id in El.set_at (Jstr.of_string "src") (Some (Jstr.of_string src)) post_image; (*prevent redirect to /img/:img*) Ev.prevent_default event; Ev.stop_propagation event let render_time date_span = log "render time@\n"; let data_time = match 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 = 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 let inner_html = El.Prop.jstr (Jstr.of_string "innerHTML") in 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 let on_hashchange _event = log "on hashchange"; let frag = Jstr.to_string @@ Uri.fragment @@ Window.location G.window in if frag = "" then () else match find_by_id_opt frag with | None -> log "fragment not found on the page" | Some reply -> let () = match !selected_ref with | None -> () | Some item -> El.set_class (Jstr.of_string "selected") false item in El.set_class (Jstr.of_string "selected") true reply; selected_ref := Some reply let clone_element el = (* TODO: how to clone with Brr? *) let id = match El.at (Jstr.of_string "id") el with | None -> failwith "element as no id for cloning" | Some id -> Jstr.to_string id in (* get reply_div as a Jv.t *) let original_div = Jv.get Jv.global id in let div = Jv.call original_div "cloneNode" [| Jv.of_bool true |] in ignore @@ Jv.call div "setAttribute" [| Jv.of_string "id"; Jv.of_string "floating-reply-preview" |]; ignore @@ Jv.call div "setAttribute" [| Jv.of_string "class"; Jv.of_string "post highlight" |]; (* append to DOM *) (* we needs to add it to `body` and not `original_div` or it might change the display * and do buggy things with mouse events on `original_div`*) let document = Jv.get Jv.global "document" in let body = Jv.get document "body" in ignore @@ Jv.call body "append" [| div |]; (* go back to El *) match find_by_id_opt "floating-reply-preview" with | None -> failwith "error cloning element" | Some el -> el let on_mouse_over el _event = log "on mouse over@\n"; let reply_id = match El.at (Jstr.of_string "data-id") el with | None -> failwith "no data-id on element" | Some data_id -> Jstr.to_string data_id in match find_by_id_opt 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 window_height = let window = Jv.get Jv.global "window" in Jv.get window "innerHeight" |> Jv.to_int in let reply_top = El.bound_y reply_div |> int_of_float in if reply_top < window_height - 50 && reply_top + 50 > 0 then ( (* just highlight if reply is in viewport *) El.set_class (Jstr.of_string "highlight") true reply_div; highlighted_ref := Some reply_div ) else (* copy it to make new div `floating-reply-preview` *) let preview_div = clone_element reply_div in (* place it next to the reply-link el*) let top = let el_top = El.bound_y el in let h = El.bound_h preview_div in (* clamp to viewport *) let top = Float.min (el_top -. (0.5 *. h)) (float_of_int window_height -. h -. 7.0) in let top = Float.max top 0.0 in top |> int_of_float |> Format.sprintf "%dpx" |> Jstr.of_string in let left = El.bound_x el +. El.bound_w el |> int_of_float |> Format.sprintf "%dpx" |> Jstr.of_string in El.set_inline_style El.Style.position (Jstr.of_string "fixed") preview_div; El.set_inline_style El.Style.z_index (Jstr.of_string "42") preview_div; El.set_inline_style El.Style.top top preview_div; El.set_inline_style El.Style.left left preview_div; (* also highlight class doesn't work if we set inline style idk why wtf css *) El.set_inline_style El.Style.background_color (Jstr.of_string "#9dd162") preview_div; (* 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 -> El.set_class (Jstr.of_string "highlight") false highlighted_div in match !preview_ref with | None -> () | Some preview_div -> El.remove preview_div let make_pretty _event = log "make pretty@\n"; let dates = 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 Ev.click "post-image" image_click in (*add event mouse_over/out to all reply-link *) let () = add_event_to_class Ev.mouseover "reply-link" on_mouse_over in let () = add_event_to_class Ev.mouseout "reply-link" on_mouse_out in (* add fragment listener to mark as selected the linked post *) let hashchange = Ev.Type.create (Jstr.of_string "hashchange") in let (_ : Ev.listener) = Ev.listen hashchange on_hashchange (Window.as_target G.window) in (* call hashchange on page load too *) on_hashchange () (*make pretty after page load*) let () = log "add load eventlistener to make pretty@\n"; let load = Ev.Type.create (Jstr.of_string "load") in let (_ : Ev.listener) = Ev.listen load make_pretty (Window.as_target G.window) in ()