swrup/geochan
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

brr

Browse source
This commit is contained in:
Swrup 2022-04-16 15:22:02 +02:00
parent 8526313edd
commit cd03f75612
1 changed files with 110 additions and 109 deletions
Download patch file Download diff file Expand all files Collapse all files

197
src/js/js_pretty_post.ml
View file

@ -1,7 +1,6 @@
let log = Format.printf open Brr
(* TODO do like in render_time everywhere *) let log = Format.printf
let inner_html = Brr.El.Prop.jstr (Jstr.of_string "innerHTML")
type image_size = type image_size =
| Big | Big
@ -14,42 +13,40 @@ let of_string = function
let to_string = function Small -> "post-image" | Big -> "post-image-big" 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*) (*change postImage class to make it bigger/smaller on click*)
let image_click post_image event = let image_click post_image event =
log "image_click@\n"; log "image_click@\n";
let class_jstr = Jstr.of_string "class" in
let current_class = let current_class =
Jv.to_string @@ Jv.call post_image "getAttribute" [| Jv.of_string "class" |] match El.at class_jstr post_image with
| None -> failwith "no class for post_image"
| Some c -> Jstr.to_string c
in in
let new_class = let new_class =
match of_string current_class with match of_string current_class with
| Some image_size -> ( match image_size with Big -> Small | Small -> Big ) | Some image_size -> ( match image_size with Big -> Small | Small -> Big )
| None -> failwith "invalid image class name" | None -> failwith "invalid image class name"
in in
ignore El.set_at class_jstr (Some (Jstr.of_string (to_string new_class))) post_image;
@@ Jv.call post_image "setAttribute"
[| Jv.of_string "class"; Jv.of_string (to_string new_class) |];
let id = let id =
Jv.to_string match El.at (Jstr.of_string "data-id") post_image with
@@ Jv.call post_image "getAttribute" [| Jv.of_string "data-id" |] | None -> failwith "no data-id on post_image"
| Some id -> Jstr.to_string id
in in
let src = let src =
match new_class with match new_class with
| Small -> Format.sprintf "/img/s/%s" id | Small -> Format.sprintf "/img/s/%s" id
| Big -> Format.sprintf "/img/%s" id | Big -> Format.sprintf "/img/%s" id
in in
ignore El.set_at (Jstr.of_string "src") (Some (Jstr.of_string src)) post_image;
@@ Jv.call post_image "setAttribute"
[| Jv.of_string "src"; Jv.of_string src |];
(*prevent redirect to /img/:img*) (*prevent redirect to /img/:img*)
ignore @@ Jv.call event "preventDefault" [||]; Ev.prevent_default event;
ignore @@ Jv.call event "stopPropagation" [||] Ev.stop_propagation event
let render_time date_span = let render_time date_span =
log "render time@\n"; log "render time@\n";
let data_time = let data_time =
match Brr.El.at (Jstr.of_string "data-time") date_span with match El.at (Jstr.of_string "data-time") date_span with
| None -> failwith "no attribute data-time for date element" | None -> failwith "no attribute data-time for date element"
| Some data_time -> Jstr.to_float data_time | Some data_time -> Jstr.to_float data_time
in in
@ -64,7 +61,8 @@ let render_time date_span =
Format.sprintf "%02d-%02d-%02d %02d:%02d" (1900 + t.tm_year) (1 + t.tm_mon) Format.sprintf "%02d-%02d-%02d %02d:%02d" (1900 + t.tm_year) (1 + t.tm_mon)
t.tm_mday t.tm_hour t.tm_min t.tm_mday t.tm_hour t.tm_min
in in
Brr.El.set_prop inner_html (Jstr.of_string date) date_span 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 preview_ref = ref None
@ -72,84 +70,103 @@ let highlighted_ref = ref None
let selected_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 = let on_hashchange _event =
log "on hashchange"; log "on hashchange";
let frag = let frag = Jstr.to_string @@ Uri.fragment @@ Window.location G.window in
Jstr.to_string @@ Brr.Uri.fragment @@ Brr.Window.location Brr.G.window if frag = "" then ()
in else
match Jv.find Jv.global frag with match Document.find_el_by_id G.document (Jstr.of_string frag) with
| None -> log "fragment not found on the page" | None -> log "fragment not found on the page"
| Some reply -> | Some reply ->
let () = let () =
match !selected_ref with match !selected_ref with
| None -> () | None -> ()
| Some item -> remove_class "selected" item | Some item -> El.set_class (Jstr.of_string "selected") false item
in in
let () = add_class "selected" reply in El.set_class (Jstr.of_string "selected") true reply;
selected_ref := Some 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
Document.find_el_by_id G.document (Jstr.of_string "floating-reply-preview")
with
| None -> failwith "error cloning element"
| Some el -> el
let on_mouse_over el _event = let on_mouse_over el _event =
log "on mouse over@\n"; log "on mouse over@\n";
(*get id of reply *)
let reply_id = let reply_id =
Jv.to_string @@ Jv.call el "getAttribute" [| Jv.of_string "data-id" |] match El.at (Jstr.of_string "data-id") el with
| None -> failwith "no data-id on element"
| Some data_id -> data_id
in in
(* (try to) get div of reply *)
match Jv.find Jv.global reply_id with match Document.find_el_by_id G.document reply_id with
| None -> failwith "error getting reply_div, this reply is not on this page" | None -> failwith "error getting reply_div, this reply is not on this page"
| Some reply_div -> | Some reply_div ->
(* check if it in view, if it is, just make it of class `highlight` *) (* 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 = Jv.get Jv.global "window" in
let window_height = Jv.get window "innerHeight" |> Jv.to_int 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 let reply_top = El.bound_y reply_div |> int_of_float in
if reply_top < window_height - 50 then ( if reply_top < window_height - 50 && reply_top + 50 > 0 then (
let class_list = Jv.get reply_div "classList" in (* just highlight if reply is in viewport *)
ignore @@ Jv.call class_list "add" [| Jv.of_string "highlight" |]; El.set_class (Jstr.of_string "highlight") true reply_div;
highlighted_ref := Some reply_div ) highlighted_ref := Some reply_div )
else else
(* copy it to make new div `floating-reply-preview` *) (* copy it to make new div `floating-reply-preview` *)
let preview_div = Jv.call reply_div "cloneNode" [| Jv.of_bool true |] in let preview_div = clone_element reply_div 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*) (* place it next to the reply-link el*)
let bounding_rect = Jv.call el "getBoundingClientRect" [||] in
let top = let top =
let el_top = Jv.get bounding_rect "top" |> Jv.to_int in let el_top = El.bound_y el in
let reply_height = Jv.get reply_bounding_rect "height" |> Jv.to_int in let h = El.bound_h preview_div in
Int.min el_top (window_height - reply_height - 5) (* clamp to viewport *)
|> Format.sprintf "%dpx" |> Jv.of_string let top =
Float.min
(el_top -. (0.5 *. h))
(float_of_int window_height -. h -. 7.0)
in in
let right = let top = Float.max top 0.0 in
Jv.get bounding_rect "right" top |> int_of_float |> Format.sprintf "%dpx" |> Jstr.of_string
|> Jv.to_int |> Format.sprintf "%dpx" |> Jv.of_string
in in
let style = Jv.get preview_div "style" in let left =
ignore @@ Jv.set style "position" (Jv.of_string "fixed"); El.bound_x el +. El.bound_w el
ignore @@ Jv.set style "z-index" (Jv.of_int 42); |> int_of_float |> Format.sprintf "%dpx" |> Jstr.of_string
ignore @@ Jv.set style "top" top; in
ignore @@ Jv.set style "left" right; 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 *) (* set preview_div ref for on_mouse_out *)
preview_ref := Some preview_div; preview_ref := Some preview_div
()
let on_mouse_out _el _event = let on_mouse_out _el _event =
log "on mouse out@\n"; log "on mouse out@\n";
@ -158,62 +175,46 @@ let on_mouse_out _el _event =
match !highlighted_ref with match !highlighted_ref with
| None -> () | None -> ()
| Some highlighted_div -> | Some highlighted_div ->
let class_list = Jv.get highlighted_div "classList" in El.set_class (Jstr.of_string "highlight") false highlighted_div
ignore @@ Jv.call class_list "remove" [| Jv.of_string "highlight" |]
in in
match !preview_ref with match !preview_ref with
| None -> () | None -> ()
| Some preview_div -> | Some preview_div -> El.remove 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 = let make_pretty _event =
log "make pretty@\n"; log "make pretty@\n";
let add_event_to_class ~name ~event handler = let add_event_to_class ~name ~event handler =
(* TODO use brr? *) let event = Ev.Type.create (Jstr.of_string event) in
let event = Brr.Ev.Type.create (Jstr.of_string event) in let el_list = El.find_by_class (Jstr.of_string name) in
let el_list = Brr.El.find_by_class (Jstr.of_string name) in List.iter (fun el -> Ev.listen event (handler el) (El.as_target el)) el_list
List.iter
(fun el ->
(* TODO handler should take Brr.El. ? *)
Brr.Ev.listen event (handler el) (Brr.El.as_target el) )
el_list
in in
let dates = Brr.El.find_by_class (Jstr.of_string "date") in let dates = El.find_by_class (Jstr.of_string "date") in
List.iter render_time dates; List.iter render_time dates;
(*(*add event image_click to all postImage*) (*add event image_click to all postImage*)
let () = add_event_to_class ~name:"post-image" ~event:"click" image_click in let () = add_event_to_class ~name:"post-image" ~event:"click" image_click in
(*add event mouse_over/out to all reply-link *) (*add event mouse_over/out to all reply-link *)
let () = let () =
add_event_to_class ~name:"reply-link" ~event:"mouseover" on_mouse_over add_event_to_class ~name:"reply-link" ~event:"mouseover" on_mouse_over
in in
*)
let () = let () =
add_event_to_class ~name:"reply-link" ~event:"mouseout" on_mouse_out add_event_to_class ~name:"reply-link" ~event:"mouseout" on_mouse_out
in in
(* add fragment listener to mark as selected the linked post *) (* add fragment listener to mark as selected the linked post *)
let window = Jv.get Jv.global "window" in (* TODO call with brr*)
ignore let hashchange = Ev.Type.create (Jstr.of_string "hashchange") in
@@ Jv.call window "addEventListener" Ev.listen hashchange on_hashchange (Window.as_target G.window);
[| Jv.of_string "hashchange"; Jv.repr on_hashchange |] (* call hashchange on page load too *)
on_hashchange ()
(*make pretty after page load*) (*make pretty after page load*)
let () = let () =
log "add load eventlistener to make pretty@\n"; log "add load eventlistener to make pretty@\n";
let window = Jv.get Jv.global "window" in let load = Ev.Type.create (Jstr.of_string "load") in
ignore Ev.listen load make_pretty (Window.as_target G.window)
@@ 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 *) (* 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) *)