brr
This commit is contained in:
parent
cd03f75612
commit
f73e220176
20 changed files with 166 additions and 178 deletions
205
src/js/pretty_post.ml
Normal file
205
src/js/pretty_post.ml
Normal file
|
|
@ -0,0 +1,205 @@
|
|||
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
|
||||
()
|
||||
Loading…
Add table
Add a link
Reference in a new issue