From 896bfb14fa05cf07bb57216fdccd678e027bc4f9 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Fri, 9 Apr 2021 11:10:57 +0200
Subject: Update editor modules

---
 editor/popin.ml | 84 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 84 insertions(+)
 create mode 100755 editor/popin.ml

(limited to 'editor/popin.ml')

diff --git a/editor/popin.ml b/editor/popin.ml
new file mode 100755
index 0000000..cd5154d
--- /dev/null
+++ b/editor/popin.ml
@@ -0,0 +1,84 @@
+open Js_of_ocaml
+open Brr
+module PM = Prosemirror
+
+type binded_field =
+  { field: El.t
+  ; button: El.t
+  }
+
+(** Set the element position just above the selection  *)
+let set_position
+  : start:int -> end':int -> PM.View.editor_view Js.t -> El.t -> unit
+  = fun ~start ~end' view el ->
+    El.set_inline_style El.Style.display (Jstr.v "") el;
+
+    (* These are in screen coordinates *)
+    let start = view##coordsAtPos start Js.null
+    and end' = view##coordsAtPos end' Js.null in
+    let offsetParent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv el) "offsetParent") in
+
+    (* The box in which the tooltip is positioned, to use as base *)
+    let box = Jv.(Id.of_jv @@ call (Jv.Id.to_jv offsetParent) "getBoundingClientRect" [||]) in
+    let box_left = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "left") in
+    let box_bottom = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "bottom") in
+
+    (* Find a center-ish x position from the selection endpoints (when
+       crossing lines, end may be more to the left) *)
+    let left = (start##.left +. end'##.left) /. 2. in
+
+    El.set_inline_style (Jstr.v "left")
+      Jstr.( (of_float ( left -. box_left )) + (v "px") )
+      el;
+    El.set_inline_style (Jstr.v "bottom")
+      Jstr.( (of_float ( box_bottom -. start##.top )) + (v "px") )
+      el
+
+(** Build a button which allow to activate or desactivate the given Element.
+
+    The function f is called when the user validate the input.
+
+*)
+let build_field
+  : El.t -> (Jstr.t -> bool) -> binded_field
+  = fun field f ->
+
+    let button_content =
+      [ El.i
+          ~at:At.[ class' (Jstr.v "fas")
+                 ; class' (Jstr.v "fa-pen") ]
+          []
+      ] in
+
+    let button = El.button
+        button_content
+    in
+
+    Ev.listen Ev.click
+      (fun _ ->
+         match El.at (Jstr.v "contenteditable") field with
+         | Some value when (Jstr.equal value (Jstr.v "true")) ->
+           let new_value = El.prop
+               (El.Prop.jstr (Jstr.v "textContent"))
+               field in
+           begin match f new_value with
+             | true ->
+               El.set_at (Jstr.v "contenteditable") None field;
+               El.set_children button button_content
+             | false -> ()
+           end
+         | _ ->
+           El.set_at (Jstr.v "contenteditable")
+             (Some (Jstr.v "true")) field;
+           El.set_children button
+             [ El.i
+                 ~at:At.[ class' (Jstr.v "fas")
+                        ; class' (Jstr.v "fa-check") ]
+                 []
+             ]
+      )
+      (El.as_target button);
+
+    { field
+    ; button = button
+    }
-- 
cgit v1.2.3